00001  IDENTIFICATION DIVISION.                                         10/02/09
00002  PROGRAM-ID.             DTSBD382.                                DTSBD382
00003  AUTHOR.                 NORTHROP GRUMMAN.                           LV003
00004  DATE-WRITTEN.           JUNE 2005.                               DTSBD382
00005  DATE-COMPILED.                                                   DTSBD382
00006                                                                   DTSBD382
00007 *****                                                             DTSBD382
00008 *                                                                 DTSBD382
00009 *    FUNCTION:  ADD EMPLOYER RATES FROM WEB REGISTRATIONS         DTSBD382
00010 *                                                                 DTSBD382
00011 *                                                                 DTSBD382
00012 *    MODIFICATION LOG:                                            DTSBD382
00013 *                                                                 DTSBD382
00014 *    06/01/2005  INITIAL DEVELOPMENT.                             DTSBD382
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD382
00016 *                                                                 DTSBD382
00017 *    09/25/2009  MODIFIED S330 TO SET L331-OP-ID FROM T002-OP-ID  DTSBD382
00018 *                TO DISTINGUISH MODIFICATIONS FROM THE WEB FROM   DTSBD382
00019 *                THOSE MADE BY STAFF.                             DTSBD382
00020 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD382
00021 *                                                                 DTSBD382
00022 *    MM/DD/CCYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD382
00023 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD382
00024 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD382
00025 *                                                                 DTSBD382
00026 *                                                                 DTSBD382
00027 *  DESCRIPTION:                                                   DTSBD382
00028 *                                                                 DTSBD382
00029 *                                                                 DTSBD382
00030 *                                                                 DTSBD382
00031 *      MASTER FILE RECORDS READ:                                  DTSBD382
00032 *                                                                 DTSBD382
00033 *        MRTE                                                     DTSBD382
00034 *                                                                 DTSBD382
00035 *                                                                 DTSBD382
00036 *      MASTER FILE RECORDS UPDATED:                               DTSBD382
00037 *                                                                 DTSBD382
00038 *        MRTE                                                     DTSBD382
00039 *                                                                 DTSBD382
00040 *                                                                 DTSBD382
00041 *      REPORT RECORDS WRITTEN:                                    DTSBD382
00042 *                                                                 DTSBD382
00043 *        NONE                                                     DTSBD382
00044 *                                                                 DTSBD382
00045 *                                                                 DTSBD382
00046 *      MODULES CALLED:                                            DTSBD382
00047 *                                                                 DTSBD382
00048 *        DTSBU331 FORMAT AND WRITE MLOG RECORD OCCURRENCE.        DTSBD382
00049 *        DTSBU910 MASTER FILE I/O DRIVER.                         DTSBD382
00050 *        DTSBU927 BTC FILE OUTPUT.                                DTSBD382
00051 *        DTSBU941 VARIABLE LENGTH RECORD INPUT 1.                 DTSBD382
00052 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.     DTSBD382
00053 *        DTSBU947 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2.     DTSBD382
00054 *                                                                 DTSBD382
00055 *****                                                             DTSBD382
00056      SKIP3                                                        DTSBD382
00057  ENVIRONMENT DIVISION.                                            DTSBD382
00058      SKIP3                                                        DTSBD382
00059  DATA DIVISION.                                                   DTSBD382
00060      EJECT                                                        DTSBD382
00061  WORKING-STORAGE SECTION.                                         DTSBD382
000615 77  PAN-VALET PICTURE X(24) VALUE '003DTSBD382  10/02/09'.       DTSBD382
00062      SKIP3                                                        DTSBD382
00063  01  WRK-AREA.                                                    DTSBD382
00064      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +382.DTSBD382
00065      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD382'.DTSBD382
00066      05  WRK-ABEND-MSG               PIC  X(60).                  DTSBD382
00067      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBD382
00068      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSBD382
00069      05  WRK-TRACE-IND               PIC  X(01)  VALUE SPACES.    DTSBD382
00070                                                                   DTSBD382
00071      05  DISP-DATE                   PIC  X(10)  VALUE SPACES.    DTSBD382
00072      05  DISP-TIME                   PIC  X(08)  VALUE SPACES.    DTSBD382
00073      05  DISP-ABSTIME                PIC  X(16)  VALUE SPACES.    DTSBD382
00074                                                                   DTSBD382
00075      05  WRK-MSG-TEXT.                                            DTSBD382
00076          10 WRK-MSG-LINE             PIC  X(50).                  DTSBD382
00077                                                                   DTSBD382
00078  01  MSG-TABLE.                                                   DTSBD382
00079      05  MSG1-AREA.                                               DTSBD382
00080          10  MSG1-ID         PIC  X(11)  VALUE 'DTSBD382001'.     DTSBD382
00081          10  MSG1-SHORT-TEXT PIC  X(20)  VALUE '               '. DTSBD382
00082          10  MSG1-LONG-TEXT.                                      DTSBD382
00083              15  FILLER      PIC  X(30)                           DTSBD382
00084                    VALUE 'TRANSACTION FAILED -          '.        DTSBD382
00085              15  FILLER      PIC  X(30)                           DTSBD382
00086                    VALUE '                              '.        DTSBD382
00087      EJECT                                                        DTSBD382
00088  01 Y108-REC.                                                     DTSBD382
00089  ++INCLUDE DTSIY108                                               DTSBD382
00090      EJECT                                                        DTSBD382
00091  01 L004-LINK-AREA.                                               DTSBD382
00092  ++INCLUDE DTSIL004                                               DTSBD382
00093      EJECT                                                        DTSBD382
00094  01 L006-LINK-AREA.                                               DTSBD382
00095  ++INCLUDE DTSIL006                                               DTSBD382
00096      EJECT                                                        DTSBD382
00097  01 L056-LINK-AREA.                                               DTSBD382
00098  ++INCLUDE DTSIL056                                               DTSBD382
00099      EJECT                                                        DTSBD382
00100  01  L331-LINK-AREA.                                              DTSBD382
00101  ++INCLUDE DTSIL331                                               DTSBD382
00102      EJECT                                                        DTSBD382
00103  01  L910-LINK-AREA.                                              DTSBD382
00104  ++INCLUDE DTSIL910                                               DTSBD382
00105      EJECT                                                        DTSBD382
00106  01  MSKL-REC.                                                    DTSBD382
00107  ++INCLUDE DTSIMSKL                                               DTSBD382
00108      EJECT                                                        DTSBD382
00109  01  MRTE-REC.                                                    DTSBD382
00110  ++INCLUDE DTSIMRTE                                               DTSBD382
00111                                                                   DTSBD382
00112  01  R907-REC.                                                    DTSBD382
00113  ++INCLUDE DTSIR907                                               DTSBD382
00114      EJECT                                                        DTSBD382
00115                                                                   DTSBD382
00116  LINKAGE SECTION.                                                 DTSBD382
00117      SKIP3                                                        DTSBD382
00118  01  LBCM-LINK-AREA.                                              DTSBD382
00119  ++INCLUDE DTSILBCM                                               DTSBD382
00120      EJECT                                                        DTSBD382
00121  01  MPRF-REC.                                                    DTSBD382
00122  ++INCLUDE DTSIMPRF                                               DTSBD382
00123      EJECT                                                        DTSBD382
00124  01  T002-REC.                                                    DTSBD382
00125  ++INCLUDE DTSIT002                                               DTSBD382
00126      EJECT                                                        DTSBD382
00127  PROCEDURE DIVISION USING LBCM-LINK-AREA                          DTSBD382
00128                           MPRF-REC                                DTSBD382
00129                           T002-REC.                               DTSBD382
00130                                                                   DTSBD382
00131 *&                                                                DTSBD382
00132      DISPLAY 'DTSBD382 ' MPRF-EMP-NO '  ' T002-TRN-CD             DTSBD382
00133         '  WRK ' WRK-EMP-NO.                                      DTSBD382
00134 *&                                                                DTSBD382
00135      IF FIRST-TIME-IND = 'Y'                                      DTSBD382
00136          PERFORM I0000-INITIATE THRU I0000-EXIT                   DTSBD382
00137          MOVE 'N' TO FIRST-TIME-IND                               DTSBD382
00138      END-IF.                                                      DTSBD382
00139                                                                   DTSBD382
00140      PERFORM P0000-PROCESS THRU P0000-EXIT                        DTSBD382
00141                                                                   DTSBD382
00142      GOBACK.                                                      DTSBD382
00143                                                                   DTSBD382
00144  I0000-INITIATE.                                                  DTSBD382
00145                                                                   DTSBD382
00146      MOVE +0                  TO WRK-EMP-NO.                      DTSBD382
00147      MOVE LENGTH OF R907-REC  TO R907-LENGTH.                     DTSBD382
00148                                                                   DTSBD382
00149  I0000-EXIT.                                                      DTSBD382
00150      EXIT.                                                        DTSBD382
00151                                                                   DTSBD382
00152  P0000-PROCESS.                                                   DTSBD382
00153                                                                   DTSBD382
00154      IF T002-EMP-RATE-88                                          DTSBD382
00155         MOVE T002-DATA-AREA            TO Y108-REC                DTSBD382
00156         PERFORM P1000-ADD-RATE         THRU P1000-EXIT            DTSBD382
00157      END-IF.                                                      DTSBD382
00158                                                                   DTSBD382
00159  P0000-EXIT.                                                      DTSBD382
00160      EXIT.                                                        DTSBD382
00161                                                                   DTSBD382
00162  P1000-ADD-RATE.                                                  DTSBD382
00163 *&                                                                DTSBD382
00164      DISPLAY 'BD382 P1000 ' MPRF-EMP-NO                           DTSBD382
00165         '  ' Y108-RATE-EFF-YRQ '  ' Y108-UI-RATE.                 DTSBD382
00166 *&                                                                DTSBD382
00167      MOVE LOW-VALUES                   TO MRTE-REC.               DTSBD382
00168                                                                   DTSBD382
00169      MOVE T002-EMP-NO                  TO MRTE-EMP-NO.            DTSBD382
00170      SET MRTE-RTE-88                   TO TRUE.                   DTSBD382
00171      MOVE Y108-RATE-EFF-YRQ            TO MRTE-EFF-YRQ.           DTSBD382
00172      MOVE MRTE-KEY-AREA                TO MSKL-KEY-AREA.          DTSBD382
00173                                                                   DTSBD382
00174      PERFORM S910-READ                 THRU S910-EXIT.            DTSBD382
00175      IF L910-OK-88                                                DTSBD382
00176         MOVE MSKL-REC                  TO MRTE-REC                DTSBD382
00177         DISPLAY 'DTSBD382: RATE ALREADY ON FILE ' MPRF-EMP-NO     DTSBD382
00178            '  ' MRTE-EFF-YRQ '  ' MRTE-UI-RATE                    DTSBD382
00179      END-IF.                                                      DTSBD382
00180                                                                   DTSBD382
00181      PERFORM S330-INIT-MLOG            THRU S330-EXIT.            DTSBD382
00182                                                                   DTSBD382
00183      MOVE +0                           TO MRTE-PURGE-DATE.        DTSBD382
00184      SET L006-FROM-QTR                 TO TRUE.                   DTSBD382
00185      MOVE MRTE-EFF-YRQ                 TO L006-YRQ.               DTSBD382
00186      PERFORM S006-RATING-YRQ           THRU S006-EXIT.            DTSBD382
00187      MOVE L006-RTE-YR-END-YRQ          TO MRTE-END-YRQ.           DTSBD382
00188      MOVE Y108-UI-RATE                 TO MRTE-UI-RATE.           DTSBD382
00189      SET MRTE-RATE-TYPE-REG-88         TO TRUE.                   DTSBD382
00190      MOVE +0                           TO MRTE-NOTICE-DATE.       DTSBD382
00191      MOVE LBCM-CURR-RUN-DATE           TO MRTE-CHNG-DATE.         DTSBD382
00192                                                                   DTSBD382
00193      IF L910-OK-88                                                DTSBD382
00194         MOVE MRTE-REC                  TO MSKL-REC                DTSBD382
00195         PERFORM S910-REWRITE           THRU S910-EXIT             DTSBD382
00196      ELSE                                                         DTSBD382
00197         SET MRTE-NOT-CONVERTED-88      TO TRUE                    DTSBD382
00198         MOVE LBCM-CURR-RUN-DATE        TO MRTE-ESTB-DATE          DTSBD382
00199         MOVE MRTE-REC                  TO MSKL-REC                DTSBD382
00200         PERFORM S910-WRITE             THRU S910-EXIT             DTSBD382
00201      END-IF.                                                      DTSBD382
00202                                                                   DTSBD382
00203      MOVE SPACES TO L331-REC-OCC-ID.                              DTSBD382
00204                                                                   DTSBD382
00205      MOVE MRTE-EFF-YRQ TO L004-QTR-5-9.                           DTSBD382
00206      STRING L004-QTR-5-YR DELIMITED BY SIZE                       DTSBD382
00207             '/'           DELIMITED BY SIZE                       DTSBD382
00208             L004-QTR-5-Q  DELIMITED BY SIZE                       DTSBD382
00209        INTO                                                       DTSBD382
00210          L331-REC-OCC-ID.                                         DTSBD382
00211                                                                   DTSBD382
00212      MOVE SPACES TO L331-FROM-VALUE.                              DTSBD382
00213                                                                   DTSBD382
00214      MOVE MRTE-UI-RATE TO L056-RATE.                              DTSBD382
00215                                                                   DTSBD382
00216      SET L056-DISP1-LEFT-88 TO TRUE.                              DTSBD382
00217                                                                   DTSBD382
00218      PERFORM S056-RATE-DISPLAY THRU S056-EXIT.                    DTSBD382
00219                                                                   DTSBD382
00220      MOVE 'MRTE-UI-RATE' TO L331-FIELD-NAME.                      DTSBD382
00221                                                                   DTSBD382
00222      MOVE L056-DISP-RATE TO L331-TO-VALUE.                        DTSBD382
00223                                                                   DTSBD382
00224      PERFORM S331-WRITE-MLOG THRU S331-EXIT.                      DTSBD382
00225                                                                   DTSBD382
00226  P1000-EXIT.                                                      DTSBD382
00227      EXIT.                                                        DTSBD382
00228                                                                   DTSBD382
00229  S006-RATING-YRQ.                                                 DTSBD382
00230      CALL 'DTSBU006' USING L006-LINK-AREA.                        DTSBD382
00231                                                                   DTSBD382
00232  S006-EXIT.                                                       DTSBD382
00233      EXIT.                                                        DTSBD382
00234                                                                   DTSBD382
00235  S056-RATE-DISPLAY.                                               DTSBD382
00236      CALL 'DTSBU056' USING L056-LINK-AREA.                        DTSBD382
00237                                                                   DTSBD382
00238  S056-EXIT.                                                       DTSBD382
00239      EXIT.                                                        DTSBD382
00240                                                                   DTSBD382
00241  S330-INIT-MLOG.                                                  DTSBD382
00242      MOVE T002-EMP-NO            TO L331-EMP-NO.                  DTSBD382
00243      MOVE LBCM-CURR-RUN-DATE     TO L331-CURR-RUN-DATE.           DTSBD382
00244      ADD  +1000                  TO LBCM-EMP-ABSTIME.             DTSBD382
00245      MOVE LBCM-EMP-ABSTIME       TO L331-UPDATE-ABSTIME.          DTSBD382
00246      MOVE T002-OP-ID             TO L331-OP-ID.                   DTSBD382
00247                                                                   DTSBD382
00248  S330-EXIT.                                                       DTSBD382
00249      EXIT.                                                        DTSBD382
00250                                                                   DTSBD382
00251  S331-WRITE-MLOG.                                                 DTSBD382
00252      CALL 'DTSBU331' USING L331-LINK-AREA.                        DTSBD382
00253      SET LBCM-EMP-UPDATE-YES-88  TO TRUE.                         DTSBD382
00254                                                                   DTSBD382
00255  S331-EXIT.                                                       DTSBD382
00256      EXIT.                                                        DTSBD382
00257                                                                   DTSBD382
00258  S910-OPEN-READ.                                                  DTSBD382
00259      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD382
00260      GO TO S910-MSTR-IO.                                          DTSBD382
00261                                                                   DTSBD382
00262  S910-OPEN-UPDATE.                                                DTSBD382
00263      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD382
00264      GO TO S910-MSTR-IO.                                          DTSBD382
00265                                                                   DTSBD382
00266  S910-OPEN-UPDATE-NO-AIX.                                         DTSBD382
00267      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBD382
00268      GO TO S910-MSTR-IO.                                          DTSBD382
00269                                                                   DTSBD382
00270  S910-READ.                                                       DTSBD382
00271      SET L910-READ-88 TO TRUE.                                    DTSBD382
00272      GO TO S910-MSTR-IO.                                          DTSBD382
00273                                                                   DTSBD382
00274  S910-START-BROWSE.                                               DTSBD382
00275      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD382
00276      GO TO S910-MSTR-IO.                                          DTSBD382
00277                                                                   DTSBD382
00278  S910-READ-NEXT.                                                  DTSBD382
00279      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD382
00280      GO TO S910-MSTR-IO.                                          DTSBD382
00281                                                                   DTSBD382
00282  S910-COUNT.                                                      DTSBD382
00283      SET L910-COUNT-88 TO TRUE.                                   DTSBD382
00284      GO TO S910-MSTR-IO.                                          DTSBD382
00285                                                                   DTSBD382
00286  S910-WRITE.                                                      DTSBD382
00287      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD382
00288      SET L910-WRITE-88 TO TRUE.                                   DTSBD382
00289      GO TO S910-MSTR-IO.                                          DTSBD382
00290                                                                   DTSBD382
00291  S910-REWRITE.                                                    DTSBD382
00292      SET LBCM-EMP-UPDATE-YES-88 TO TRUE.                          DTSBD382
00293      SET L910-REWRITE-88 TO TRUE.                                 DTSBD382
00294      GO TO S910-MSTR-IO.                                          DTSBD382
00295                                                                   DTSBD382
00296  S910-DELETE.                                                     DTSBD382
00297      SET L910-DELETE-88 TO TRUE.                                  DTSBD382
00298      GO TO S910-MSTR-IO.                                          DTSBD382
00299                                                                   DTSBD382
00300  S910-CLOSE.                                                      DTSBD382
00301      SET L910-CLOSE-88     TO TRUE.                               DTSBD382
00302      GO TO S910-MSTR-IO.                                          DTSBD382
00303                                                                   DTSBD382
00304  S910-MSTR-IO.                                                    DTSBD382
00305      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD382
00306                            MSKL-REC.                              DTSBD382
00307  S910-EXIT.                                                       DTSBD382
00308      EXIT.                                                        DTSBD382
00309                                                                   DTSBD382
00310  S947-WRITE-R907.                                                 DTSBD382
00311      CALL 'DTSBU947' USING R907-REC.                              DTSBD382
00312                                                                   DTSBD382
00313  S947-EXIT.                                                       DTSBD382
00314      EXIT.                                                        DTSBD382
00315                                                                   DTSBD382
00316  S999-ABEND.                                                      DTSBD382
00317      DISPLAY '*** DTSBD382 ABENDING : '                           DTSBD382
00318              WRK-ABEND-MSG.                                       DTSBD382
00319                                                                   DTSBD382
00320      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD382
00321  S999-EXIT.                                                       DTSBD382
00322      EXIT.                                                        DTSBD382
00323                                                                   DTSBD382
