00001  IDENTIFICATION DIVISION.                                         11/22/04
00002  PROGRAM-ID.             DTSBD992.                                DTSBD992
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV006
00004  DATE-WRITTEN.           OCTOBER 1992.                            DTSBD992
00005  DATE-COMPILED.                                                   DTSBD992
00006      SKIP3                                                        DTSBD992
00007 *****                                                             DTSBD992
00008 *                                                                 DTSBD992
00009 *    FUNCTION:  INSERT EMPLOYERS ONTO MASTER FILE.                DTSBD992
00010 *                                                                 DTSBD992
00011 *                                                                 DTSBD992
00012 *    MODIFICATION LOG:                                            DTSBD992
00013 *                                                                 DTSBD992
00014 *    12/01/1998  INITIAL DEVELOPMENT.        COPIED FROM MACBU992 DTSBD992
00015 *                WORK ORDER:                      PROGRAMMER: ZL1 DTSBD992
00016 *                                                                 DTSBD992
00017 *    07/08/2004  ADDED 'HEADER NEEDED' PARM. WITH PARM SET TO NO, DTSBD992
00018 *                THE PROGRAM CAN BE USED TO COPY INDIVIDUAL       DTSBD992
00019 *                EMPLOYER RECORDS FROM ONE REGION TO ANOTHER.     DTSBD992
00020 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD992
00021 *                                                                 DTSBD992
00022 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD992
00023 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD992
00024 *              WORK ORDER:                      PROGRAMMER: XXX   DTSBD992
00025 *                                                                 DTSBD992
00026 *                                                                 DTSBD992
00027 *  DESCRIPTION:                                                   DTSBD992
00028 *                                                                 DTSBD992
00029 *****                                                             DTSBD992
00030      SKIP3                                                        DTSBD992
00031  ENVIRONMENT DIVISION.                                            DTSBD992
00032      SKIP3                                                        DTSBD992
00033  DATA DIVISION.                                                   DTSBD992
00034      SKIP3                                                        DTSBD992
00035  WORKING-STORAGE SECTION.                                         DTSBD992
000355 77  PAN-VALET PICTURE X(24) VALUE '006DTSBD992  11/22/04'.       DTSBD992
00036      SKIP3                                                        DTSBD992
00037  01  WRK-AREA.                                                    DTSBD992
00038      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +992.DTSBD992
00039                                                                   DTSBD992
00040      05  WRK-PRF-REC-CNT             PIC S9(07)  COMP-3.          DTSBD992
00041                                                                   DTSBD992
00042      05  WRK-TOT-REC-CNT             PIC S9(07)  COMP-3.          DTSBD992
00043                                                                   DTSBD992
00044      05  ALREADY-EXISTS-IND          PIC  X(01).                  DTSBD992
00045                                                                   DTSBD992
00046      05  AIX-UPDATE-IND              PIC  X(01).                  DTSBD992
00047                                                                   DTSBD992
00048      05  HDR-NEEDED-IND              PIC  X(01).                  DTSBD992
00049          88  HDR-NEEDED-YES-88        VALUE 'Y'.                  DTSBD992
00050          88  HDR-NEEDED-NO-88         VALUE 'N'.                  DTSBD992
00051      EJECT                                                        DTSBD992
00052  01  L910-LINK-AREA.                                              DTSBD992
00053  ++INCLUDE DTSIL910                                               DTSBD992
00054      EJECT                                                        DTSBD992
00055  01  MSKL-REC.                                                    DTSBD992
00056  ++INCLUDE DTSIMSKL                                               DTSBD992
00057      EJECT                                                        DTSBD992
00058  01  MPRF-REC.                                                    DTSBD992
00059  ++INCLUDE DTSIMPRF                                               DTSBD992
00060      EJECT                                                        DTSBD992
00061  01  L961-LINK-AREA.                                              DTSBD992
00062  ++INCLUDE DTSIL961                                               DTSBD992
00063      EJECT                                                        DTSBD992
00064  01  L921-LINK-AREA.                                              DTSBD992
00065  ++INCLUDE DTSIL921                                               DTSBD992
00066      EJECT                                                        DTSBD992
00067  01  ISKL-REC.                                                    DTSBD992
00068  ++INCLUDE DTSIISKL                                               DTSBD992
00069      EJECT                                                        DTSBD992
00070  LINKAGE SECTION.                                                 DTSBD992
00071      SKIP3                                                        DTSBD992
00072  01  PARM-AREA.                                                   DTSBD992
00073      05  PARM-LENGTH                  PIC S9(04)  COMP.           DTSBD992
00074      05  PARM-DATA.                                               DTSBD992
00075          10  PARM-AIX-UPDATE-IND      PIC  X(01).                 DTSBD992
00076          10  FILLER                   PIC  X(01).                 DTSBD992
00077          10  PARM-HDR-NEEDED-IND      PIC  X(01).                 DTSBD992
00078      EJECT                                                        DTSBD992
00079  PROCEDURE DIVISION USING PARM-AREA.                              DTSBD992
00080                                                                   DTSBD992
00081                                                                   DTSBD992
00082      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD992
00083                                                                   DTSBD992
00084      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD992
00085                                                                   DTSBD992
00086      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD992
00087                                                                   DTSBD992
00088                                                                   DTSBD992
00089      GOBACK.                                                      DTSBD992
00090      EJECT                                                        DTSBD992
00091  I0000-INITIATE.                                                  DTSBD992
00092      PERFORM I1000-EDIT-PARM           THRU I1000-EXIT.           DTSBD992
00093                                                                   DTSBD992
00094      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT.           DTSBD992
00095                                                                   DTSBD992
00096      PERFORM I3000-INITIALIZE-WRK      THRU I3000-EXIT.           DTSBD992
00097  I0000-EXIT.                                                      DTSBD992
00098      EXIT.                                                        DTSBD992
00099      EJECT                                                        DTSBD992
00100  I1000-EDIT-PARM.                                                 DTSBD992
00101      DISPLAY 'PARM LENGTH ' PARM-LENGTH.                          DTSBD992
00102                                                                   DTSBD992
00103      IF PARM-LENGTH = +0                                          DTSBD992
00104          MOVE 'Y' TO AIX-UPDATE-IND                               DTSBD992
00105      ELSE                                                         DTSBD992
00106      IF PARM-LENGTH = +3                                          DTSBD992
00107          NEXT SENTENCE                                            DTSBD992
00108      ELSE                                                         DTSBD992
00109          DISPLAY 'INVALID PARM LENGTH ENCOUNTERED'                DTSBD992
00110          PERFORM S999-ABEND THRU S999-EXIT                        DTSBD992
00111      END-IF.                                                      DTSBD992
00112                                                                   DTSBD992
00113      IF PARM-AIX-UPDATE-IND = 'N' OR 'Y'                          DTSBD992
00114          MOVE PARM-AIX-UPDATE-IND TO AIX-UPDATE-IND               DTSBD992
00115      ELSE                                                         DTSBD992
00116          DISPLAY 'AIX UPDATE PARM INVALID '                       DTSBD992
00117          PERFORM S999-ABEND THRU S999-EXIT                        DTSBD992
00118      END-IF.                                                      DTSBD992
00119                                                                   DTSBD992
00120      IF PARM-HDR-NEEDED-IND = 'N' OR 'Y'                          DTSBD992
00121          MOVE PARM-HDR-NEEDED-IND TO HDR-NEEDED-IND               DTSBD992
00122      ELSE                                                         DTSBD992
00123          DISPLAY 'HEADER PARM INVALID     '                       DTSBD992
00124          PERFORM S999-ABEND THRU S999-EXIT                        DTSBD992
00125      END-IF.                                                      DTSBD992
00126                                                                   DTSBD992
00127  I1000-EXIT.                                                      DTSBD992
00128      EXIT.                                                        DTSBD992
00129      EJECT                                                        DTSBD992
00130  I2000-OPEN-FILES.                                                DTSBD992
00131      MOVE 'N' TO L910-TRACE-IND                                   DTSBD992
00132                  L921-TRACE-IND                                   DTSBD992
00133                  L961-TRACE-IND.                                  DTSBD992
00134                                                                   DTSBD992
00135      MOVE 'DTSBD992' TO L910-MOD-NAME                             DTSBD992
00136                         L921-MOD-NAME                             DTSBD992
00137                         L961-MOD-NAME.                            DTSBD992
00138                                                                   DTSBD992
00139      IF AIX-UPDATE-IND = 'N'                                      DTSBD992
00140          PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT           DTSBD992
00141      ELSE                                                         DTSBD992
00142          PERFORM S910-OPEN-UPDATE THRU S910-EXIT                  DTSBD992
00143          PERFORM S921-OPEN-UPDATE THRU S921-EXIT                  DTSBD992
00144      END-IF.                                                      DTSBD992
00145                                                                   DTSBD992
00146      PERFORM S961-OPEN-READ THRU S961-EXIT.                       DTSBD992
00147  I2000-EXIT.                                                      DTSBD992
00148      EXIT.                                                        DTSBD992
00149      EJECT                                                        DTSBD992
00150  I3000-INITIALIZE-WRK.                                            DTSBD992
00151      MOVE +0 TO WRK-PRF-REC-CNT                                   DTSBD992
00152                 WRK-TOT-REC-CNT.                                  DTSBD992
00153  I3000-EXIT.                                                      DTSBD992
00154      EXIT.                                                        DTSBD992
00155      EJECT                                                        DTSBD992
00156  P0000-PROCESS.                                                   DTSBD992
00157      PERFORM S961-READ-NEXT THRU S961-EXIT.                       DTSBD992
00158      IF L961-NO-REC-88                                            DTSBD992
00159          GO TO P0000-EXIT.                                        DTSBD992
00160                                                                   DTSBD992
00161      IF MSKL-HDR-88                                               DTSBD992
00162         PERFORM S910-WRITE THRU S910-EXIT                         DTSBD992
00163         ADD +1 TO WRK-TOT-REC-CNT                                 DTSBD992
00164      ELSE                                                         DTSBD992
00165         IF HDR-NEEDED-YES-88                                      DTSBD992
00166            DISPLAY 'DTSBD992 NO HEADER FOUND '                    DTSBD992
00167            GO TO P0000-EXIT.                                      DTSBD992
00168                                                                   DTSBD992
00169      MOVE -1 TO MPRF-EMP-NO.                                      DTSBD992
00170      PERFORM P1000-FIRST-MPRF THRU P1000-EXIT                     DTSBD992
00171          UNTIL (MPRF-EMP-NO NOT = -1)                             DTSBD992
00172                    OR                                             DTSBD992
00173                (L961-NO-REC-88).                                  DTSBD992
00174                                                                   DTSBD992
00175      PERFORM P2000-PROCESS-IN-FILE THRU P2000-EXIT                DTSBD992
00176          UNTIL L961-NO-REC-88.                                    DTSBD992
00177  P0000-EXIT.                                                      DTSBD992
00178      EXIT.                                                        DTSBD992
00179      EJECT                                                        DTSBD992
00180  P1000-FIRST-MPRF.                                                DTSBD992
00181      IF HDR-NEEDED-YES-88                                         DTSBD992
00182         PERFORM S961-READ-NEXT THRU S961-EXIT                     DTSBD992
00183         IF L961-NO-REC-88                                         DTSBD992
00184            GO TO P1000-EXIT.                                      DTSBD992
00185                                                                   DTSBD992
00186      IF MSKL-PRF-88                                               DTSBD992
00187          PERFORM S1000-INITIATE-MPRF THRU S1000-EXIT              DTSBD992
00188      ELSE                                                         DTSBD992
00189          DISPLAY MSKL-EMP-NO                                      DTSBD992
00190                  '  '                                             DTSBD992
00191                  MSKL-REC-TYPE                                    DTSBD992
00192                  '  RECORD BYPASSED.  NO CORRESPONDING MPRF.'.    DTSBD992
00193  P1000-EXIT.                                                      DTSBD992
00194      EXIT.                                                        DTSBD992
00195      EJECT                                                        DTSBD992
00196  P2000-PROCESS-IN-FILE.                                           DTSBD992
00197      PERFORM S961-READ-NEXT THRU S961-EXIT.                       DTSBD992
00198      IF L961-NO-REC-88                                            DTSBD992
00199          PERFORM S2000-TERMINATE-MPRF THRU S2000-EXIT             DTSBD992
00200          GO TO P2000-EXIT.                                        DTSBD992
00201                                                                   DTSBD992
00202      IF MSKL-PRF-88                                               DTSBD992
00203          PERFORM S2000-TERMINATE-MPRF THRU S2000-EXIT             DTSBD992
00204          PERFORM S1000-INITIATE-MPRF THRU S1000-EXIT              DTSBD992
00205          GO TO P2000-EXIT.                                        DTSBD992
00206                                                                   DTSBD992
00207      IF MSKL-EMP-NO NOT = MPRF-EMP-NO                             DTSBD992
00208          DISPLAY MSKL-EMP-NO                                      DTSBD992
00209                  '  '                                             DTSBD992
00210                  MSKL-REC-TYPE                                    DTSBD992
00211                  '  RECORD BYPASSED.  NO CORRESPONDING MPRF'      DTSBD992
00212          GO TO P2000-EXIT.                                        DTSBD992
00213                                                                   DTSBD992
00214      IF ALREADY-EXISTS-IND = 'Y'                                  DTSBD992
00215          DISPLAY MSKL-EMP-NO                                      DTSBD992
00216                  '  '                                             DTSBD992
00217                  MSKL-REC-TYPE                                    DTSBD992
00218                  '  RECORD BYPASSED.  EMPLOYER ALREADY EXISTS.'   DTSBD992
00219          GO TO P2000-EXIT.                                        DTSBD992
00220                                                                   DTSBD992
00221      PERFORM S910-WRITE THRU S910-EXIT.                           DTSBD992
00222                                                                   DTSBD992
00223      ADD +1 TO WRK-TOT-REC-CNT.                                   DTSBD992
00224  P2000-EXIT.                                                      DTSBD992
00225      EXIT.                                                        DTSBD992
00226      EJECT                                                        DTSBD992
00227  T0000-TERMINATE.                                                 DTSBD992
00228      DISPLAY ' '.                                                 DTSBD992
00229      DISPLAY '*** DTSBD992 TERMINATION STATISTICS ***'.           DTSBD992
00230      DISPLAY ' '.                                                 DTSBD992
00231      DISPLAY 'NUMBER OF MPRF RECORDS WRITTEN    : '               DTSBD992
00232              WRK-PRF-REC-CNT.                                     DTSBD992
00233      DISPLAY ' '.                                                 DTSBD992
00234      DISPLAY 'NUMBER OF RECORDS WRITTEN         : '               DTSBD992
00235              WRK-TOT-REC-CNT.                                     DTSBD992
00236                                                                   DTSBD992
00237      PERFORM S910-CLOSE        THRU S910-EXIT.                    DTSBD992
00238                                                                   DTSBD992
00239      IF AIX-UPDATE-IND = 'Y'                                      DTSBD992
00240         PERFORM S921-CLOSE     THRU S921-EXIT                     DTSBD992
00241      END-IF.                                                      DTSBD992
00242                                                                   DTSBD992
00243      PERFORM S961-CLOSE        THRU S961-EXIT.                    DTSBD992
00244  T0000-EXIT.                                                      DTSBD992
00245      EXIT.                                                        DTSBD992
00246      EJECT                                                        DTSBD992
00247  S1000-INITIATE-MPRF.                                             DTSBD992
00248      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD992
00249      PERFORM S910-READ THRU S910-EXIT.                            DTSBD992
00250      IF L910-OK-88                                                DTSBD992
00251          MOVE 'Y' TO ALREADY-EXISTS-IND                           DTSBD992
00252          DISPLAY MSKL-EMP-NO                                      DTSBD992
00253                  '  '                                             DTSBD992
00254                  MSKL-REC-TYPE                                    DTSBD992
00255                  '  EMPLOYER BYPASSED.  EMPLOYER ALREADY EXISTS.' DTSBD992
00256      ELSE                                                         DTSBD992
00257          MOVE 'N' TO ALREADY-EXISTS-IND                           DTSBD992
00258          PERFORM S910-WRITE THRU S910-EXIT                        DTSBD992
00259          ADD +1 TO WRK-PRF-REC-CNT                                DTSBD992
00260                    WRK-TOT-REC-CNT.                               DTSBD992
00261                                                                   DTSBD992
00262  S1000-EXIT.                                                      DTSBD992
00263      EXIT.                                                        DTSBD992
00264      EJECT                                                        DTSBD992
00265  S2000-TERMINATE-MPRF.                                            DTSBD992
00266  S2000-EXIT.                                                      DTSBD992
00267      EXIT.                                                        DTSBD992
00268      EJECT                                                        DTSBD992
00269  S910-OPEN-UPDATE.                                                DTSBD992
00270      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD992
00271      GO TO S910-MSTR-IO.                                          DTSBD992
00272                                                                   DTSBD992
00273  S910-OPEN-UPDATE-NO-AIX.                                         DTSBD992
00274      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBD992
00275      GO TO S910-MSTR-IO.                                          DTSBD992
00276                                                                   DTSBD992
00277  S910-READ.                                                       DTSBD992
00278      SET L910-READ-88 TO TRUE.                                    DTSBD992
00279      GO TO S910-MSTR-IO.                                          DTSBD992
00280                                                                   DTSBD992
00281 *S910-START-BROWSE.                                               DTSBD992
00282 *****SET L910-START-BROWSE-88 TO TRUE.                            DTSBD992
00283 *****GO TO S910-MSTR-IO.                                          DTSBD992
00284                                                                   DTSBD992
00285 *S910-READ-NEXT.                                                  DTSBD992
00286 *****SET L910-READ-NEXT-88 TO TRUE.                               DTSBD992
00287 *****GO TO S910-MSTR-IO.                                          DTSBD992
00288                                                                   DTSBD992
00289  S910-WRITE.                                                      DTSBD992
00290      SET L910-WRITE-88 TO TRUE.                                   DTSBD992
00291      GO TO S910-MSTR-IO.                                          DTSBD992
00292                                                                   DTSBD992
00293 *S910-REWRITE.                                                    DTSBD992
00294 *****SET L910-REWRITE-88 TO TRUE.                                 DTSBD992
00295 *****GO TO S910-MSTR-IO.                                          DTSBD992
00296                                                                   DTSBD992
00297 *S910-DELETE.                                                     DTSBD992
00298 *****SET L910-DELETE-88 TO TRUE.                                  DTSBD992
00299 *****GO TO S910-MSTR-IO.                                          DTSBD992
00300                                                                   DTSBD992
00301  S910-CLOSE.                                                      DTSBD992
00302      SET L910-CLOSE-88 TO TRUE.                                   DTSBD992
00303      GO TO S910-MSTR-IO.                                          DTSBD992
00304                                                                   DTSBD992
00305  S910-MSTR-IO.                                                    DTSBD992
00306      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD992
00307                            MSKL-REC.                              DTSBD992
00308  S910-EXIT.                                                       DTSBD992
00309      EXIT.                                                        DTSBD992
00310      SKIP3                                                        DTSBD992
00311  S921-OPEN-UPDATE.                                                DTSBD992
00312      SET L921-OPEN-UPDATE-88 TO TRUE.                             DTSBD992
00313      GO TO S921-ALT-INDEX-IO.                                     DTSBD992
00314                                                                   DTSBD992
00315  S921-CLOSE.                                                      DTSBD992
00316      SET L921-CLOSE-88 TO TRUE.                                   DTSBD992
00317      GO TO S921-ALT-INDEX-IO.                                     DTSBD992
00318                                                                   DTSBD992
00319  S921-ALT-INDEX-IO.                                               DTSBD992
00320      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD992
00321                            ISKL-REC.                              DTSBD992
00322  S921-EXIT.                                                       DTSBD992
00323      EXIT.                                                        DTSBD992
00324      SKIP3                                                        DTSBD992
00325  S961-OPEN-READ.                                                  DTSBD992
00326      SET L961-OPEN-READ-88 TO TRUE.                               DTSBD992
00327      GO TO S961-SEQ-MSTR-I.                                       DTSBD992
00328                                                                   DTSBD992
00329  S961-READ-NEXT.                                                  DTSBD992
00330      SET L961-READ-NEXT-88 TO TRUE.                               DTSBD992
00331      GO TO S961-SEQ-MSTR-I.                                       DTSBD992
00332                                                                   DTSBD992
00333  S961-CLOSE.                                                      DTSBD992
00334      SET L961-CLOSE-88 TO TRUE.                                   DTSBD992
00335      GO TO S961-SEQ-MSTR-I.                                       DTSBD992
00336                                                                   DTSBD992
00337  S961-SEQ-MSTR-I.                                                 DTSBD992
00338      CALL 'DTSBU961' USING L961-LINK-AREA                         DTSBD992
00339                            MSKL-REC.                              DTSBD992
00340  S961-EXIT.                                                       DTSBD992
00341      EXIT.                                                        DTSBD992
00342      SKIP3                                                        DTSBD992
00343  S999-ABEND.                                                      DTSBD992
00344      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD992
00345  S999-EXIT.                                                       DTSBD992
00346      EXIT.                                                        DTSBD992
