00001  IDENTIFICATION DIVISION.                                         04/05/04
00002  PROGRAM-ID.             DTSBU981.                                DTSBU981
00003  AUTHOR.                 TRW.                                        LV011
00004  DATE-WRITTEN.           FEBRUARY 2002.                           DTSBU981
00005  DATE-COMPILED.                                                   DTSBU981
00006      SKIP3                                                        DTSBU981
00007 *****                                                             DTSBU981
00008 *                                                                 DTSBU981
00009 *    FUNCTION:  WAGE HISTORY FILE INPUT/OUTPUT.                   DTSBU981
00010 *                                                                 DTSBU981
00011 *                                                                 DTSBU981
00012 *    MODIFICATION LOG:                                            DTSBU981
00013 *                                                                 DTSBU981
00014 *    12/28/2001  INITIAL DEVELOPMENT.                             DTSBU981
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU981
00016 *                                                                 DTSBU981
00017 *    10/06/2003  RECOMPILED FOR NEW VERSION OF WGH RECORD.        DTSBU981
00018 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU981
00019 *                                                                 DTSBU981
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU981
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU981
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU981
00023 *                                                                 DTSBU981
00024 *                                                                 DTSBU981
00025 *    DESCRIPTION:                                                 DTSBU981
00026 *                                                                 DTSBU981
00027 *        DTSBU981 PERFORMS ALL REQUIRED WAGE HISTORY FILE         DTSBU981
00028 *        INPUT/OUTPUT.                                            DTSBU981
00029 *                                                                 DTSBU981
00030 *                                                                 DTSBU981
00031 *    GENERAL SPECIFICATIONS:                                      DTSBU981
00032 *                                                                 DTSBU981
00033 *        ALL COMMANDS ARE VALID.                                  DTSBU981
00034 *                                                                 DTSBU981
00035 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DTSBU981
00036 *        MODULE.                                                  DTSBU981
00037 *                                                                 DTSBU981
00038 *        IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS    DTSBU981
00039 *        ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A           DTSBU981
00040 *        FILE-STATUS OF '97' FROM AN OPEN COMMAND).               DTSBU981
00041 *                                                                 DTSBU981
00042 *                                                                 DTSBU981
00043 *                                                                 DTSBU981
00044 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSBU981
00045 *                                                                 DTSBU981
00046 *    OPEN-READ                                                    DTSBU981
00047 *        OPEN INPUT.                                              DTSBU981
00048 *                                                                 DTSBU981
00049 *    OPEN-UPDATE                                                  DTSBU981
00050 *        OPEN I-O.                                                DTSBU981
00051 *                                                                 DTSBU981
00052 *    CLOSE                                                        DTSBU981
00053 *                                                                 DTSBU981
00054 *    READ                                                         DTSBU981
00055 *                                                                 DTSBU981
00056 *    START BROWSE                                                 DTSBU981
00057 *        IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE      DTSBU981
00058 *        READ-NEXT LOGIC.  A SUCCESSFUL START-BROWSE RETURNS      DTSBU981
00059 *        A RECORD.                                                DTSBU981
00060 *                                                                 DTSBU981
00061 *    READ NEXT                                                    DTSBU981
00062 *                                                                 DTSBU981
00063 *    WRITE                                                        DTSBU981
00064 *                                                                 DTSBU981
00065 *    REWRITE                                                      DTSBU981
00066 *                                                                 DTSBU981
00067 *    DELETE                                                       DTSBU981
00068 *                                                                 DTSBU981
00069 *                                                                 DTSBU981
00070 *****                                                             DTSBU981
00071      SKIP3                                                        DTSBU981
00072  ENVIRONMENT DIVISION.                                            DTSBU981
00073      SKIP2                                                        DTSBU981
00074  INPUT-OUTPUT SECTION.                                            DTSBU981
00075                                                                   DTSBU981
00076  FILE-CONTROL.                                                    DTSBU981
00077      SELECT WGH-FILE ASSIGN TO DTSFWGH                            DTSBU981
00078          ORGANIZATION IS INDEXED                                  DTSBU981
00079          RECORD KEY IS WWGH-KEY-AREA OF FILE-REC                  DTSBU981
00080          FILE STATUS IS FILE-STATUS                               DTSBU981
00081          ACCESS IS DYNAMIC.                                       DTSBU981
00082      SKIP3                                                        DTSBU981
00083  DATA DIVISION.                                                   DTSBU981
00084      SKIP3                                                        DTSBU981
00085  FILE SECTION.                                                    DTSBU981
00086      SKIP3                                                        DTSBU981
00087  FD  WGH-FILE.                                                    DTSBU981
00088                                                                   DTSBU981
00089  01  FILE-REC.                                                    DTSBU981
00090  ++INCLUDE DTSIWWGH                                               DTSBU981
00091      EJECT                                                        DTSBU981
00092  WORKING-STORAGE SECTION.                                         DTSBU981
000925 77  PAN-VALET PICTURE X(24) VALUE '011DTSBU981  04/05/04'.       DTSBU981
00093      SKIP3                                                        DTSBU981
00094  01  WRK-AREA.                                                    DTSBU981
00095      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +981.DTSBU981
00096                                                                   DTSBU981
00097      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBU981'.DTSBU981
00098                                                                   DTSBU981
00099      05  WRK-REC-PREFIX              PIC  X(04).                  DTSBU981
00100                                                                   DTSBU981
00101      05  WRK-KEY-LENGTH              PIC S9(04)  COMP             DTSBU981
00102                                          VALUE +12.               DTSBU981
00103                                                                   DTSBU981
00104      05  FILE-STATUS                 PIC  X(02).                  DTSBU981
00105          88  FILE-OK-88                  VALUE '00'.              DTSBU981
00106          88  FILE-NO-REC-88              VALUE '10' '23'.         DTSBU981
00107          88  FILE-DUP-REC-88             VALUE '22'.              DTSBU981
00108          88  FILE-VERIFY-88              VALUE '97'.              DTSBU981
00109      EJECT                                                        DTSBU981
00110  01  WS-SPEC-DISP-AREA.                                           DTSBU981
00111                                                                   DTSBU981
00112      10  WS-KEY-AREA.                                             DTSBU981
00113          15  WS-EMP-NO             PIC  9(07).                    DTSBU981
00114          15  FILLER                PIC  X(01) VALUE SPACE.        DTSBU981
00115          15  WS-YRQ                PIC  9(05).                    DTSBU981
00116          15  FILLER                PIC  X(01) VALUE SPACE.        DTSBU981
00117          15  WS-SSN                PIC  9(09).                    DTSBU981
00118          15  FILLER                PIC  X(01) VALUE SPACE.        DTSBU981
00119                                                                   DTSBU981
00120      10  WS-DATA-AREA.                                            DTSBU981
00121          15  WS-EARNINGS           PIC  9(09)V99-.                DTSBU981
00122      EJECT                                                        DTSBU981
00123  01  L991-LINK-AREA.                                              DTSBU981
00124  ++INCLUDE DTSIL991                                               DTSBU981
00125      EJECT                                                        DTSBU981
00126  LINKAGE SECTION.                                                 DTSBU981
00127      SKIP3                                                        DTSBU981
00128  01  L981-LINK-AREA.                                              DTSBU981
00129  ++INCLUDE DTSIL981                                               DTSBU981
00130      EJECT                                                        DTSBU981
00131  01  LINK-REC.                                                    DTSBU981
00132      05  WWGH-REC.                                                DTSBU981
00133  ++INCLUDE DTSIWWGH                                               DTSBU981
00134      EJECT                                                        DTSBU981
00135  PROCEDURE DIVISION USING L981-LINK-AREA                          DTSBU981
00136                           LINK-REC.                               DTSBU981
00137                                                                   DTSBU981
00138      SET L981-OK-88 TO TRUE.                                      DTSBU981
00139                                                                   DTSBU981
00140      IF L981-TRACE-88                                             DTSBU981
00141          PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT.               DTSBU981
00142                                                                   DTSBU981
00143      IF L981-READ-NEXT-88                                         DTSBU981
00144          PERFORM P2300-READ-NEXT THRU P2300-EXIT                  DTSBU981
00145      ELSE                                                         DTSBU981
00146      IF L981-READ-88                                              DTSBU981
00147          PERFORM P2100-READ THRU P2100-EXIT                       DTSBU981
00148      ELSE                                                         DTSBU981
00149      IF L981-START-BROWSE-88                                      DTSBU981
00150          PERFORM P2200-START-BROWSE THRU P2200-EXIT               DTSBU981
00151      ELSE                                                         DTSBU981
00152      IF L981-WRITE-88                                             DTSBU981
00153          PERFORM P3100-WRITE THRU P3100-EXIT                      DTSBU981
00154      ELSE                                                         DTSBU981
00155      IF L981-REWRITE-88                                           DTSBU981
00156          PERFORM P3200-REWRITE THRU P3200-EXIT                    DTSBU981
00157      ELSE                                                         DTSBU981
00158      IF L981-DELETE-88                                            DTSBU981
00159          PERFORM P3300-DELETE THRU P3300-EXIT                     DTSBU981
00160      ELSE                                                         DTSBU981
00161      IF L981-OPEN-READ-88                                         DTSBU981
00162            OR                                                     DTSBU981
00163         L981-OPEN-UPDATE-88                                       DTSBU981
00164          PERFORM P1100-OPEN THRU P1100-EXIT                       DTSBU981
00165      ELSE                                                         DTSBU981
00166      IF L981-CLOSE-88                                             DTSBU981
00167          PERFORM P1200-CLOSE THRU P1200-EXIT                      DTSBU981
00168      ELSE                                                         DTSBU981
00169          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00170                                                                   DTSBU981
00171      IF L981-TRACE-88                                             DTSBU981
00172          PERFORM S9200-POST-DISPLAY THRU S9200-EXIT.              DTSBU981
00173      SKIP2                                                        DTSBU981
00174      GOBACK.                                                      DTSBU981
00175      EJECT                                                        DTSBU981
00176  P1100-OPEN.                                                      DTSBU981
00177      IF L981-OPEN-UPDATE-88                                       DTSBU981
00178          OPEN I-O WGH-FILE                                        DTSBU981
00179      ELSE                                                         DTSBU981
00180          OPEN INPUT WGH-FILE.                                     DTSBU981
00181                                                                   DTSBU981
00182      IF FILE-OK-88 OR FILE-VERIFY-88                              DTSBU981
00183          NEXT SENTENCE                                            DTSBU981
00184      ELSE                                                         DTSBU981
00185          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00186  P1100-EXIT.                                                      DTSBU981
00187      EXIT.                                                        DTSBU981
00188      SKIP3                                                        DTSBU981
00189  P1200-CLOSE.                                                     DTSBU981
00190      CLOSE WGH-FILE.                                              DTSBU981
00191                                                                   DTSBU981
00192      IF FILE-OK-88                                                DTSBU981
00193          NEXT SENTENCE                                            DTSBU981
00194      ELSE                                                         DTSBU981
00195          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00196  P1200-EXIT.                                                      DTSBU981
00197      EXIT.                                                        DTSBU981
00198      EJECT                                                        DTSBU981
00199  P2100-READ.                                                      DTSBU981
00200      MOVE WWGH-KEY-AREA OF LINK-REC                               DTSBU981
00201        TO WWGH-KEY-AREA OF FILE-REC.                              DTSBU981
00202                                                                   DTSBU981
00203      READ WGH-FILE.                                               DTSBU981
00204                                                                   DTSBU981
00205      IF FILE-OK-88                                                DTSBU981
00206          MOVE FILE-REC  TO LINK-REC                               DTSBU981
00207      ELSE                                                         DTSBU981
00208      IF FILE-NO-REC-88                                            DTSBU981
00209          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSBU981
00210      ELSE                                                         DTSBU981
00211          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00212  P2100-EXIT.                                                      DTSBU981
00213      EXIT.                                                        DTSBU981
00214      EJECT                                                        DTSBU981
00215  P2200-START-BROWSE.                                              DTSBU981
00216      MOVE WWGH-KEY-AREA OF LINK-REC                               DTSBU981
00217        TO WWGH-KEY-AREA OF FILE-REC.                              DTSBU981
00218                                                                   DTSBU981
00219      START WGH-FILE                                               DTSBU981
00220          KEY IS NOT < WWGH-KEY-AREA OF FILE-REC.                  DTSBU981
00221                                                                   DTSBU981
00222      IF FILE-OK-88                                                DTSBU981
00223          PERFORM P2300-READ-NEXT THRU P2300-EXIT                  DTSBU981
00224      ELSE                                                         DTSBU981
00225      IF FILE-NO-REC-88                                            DTSBU981
00226          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSBU981
00227      ELSE                                                         DTSBU981
00228          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00229  P2200-EXIT.                                                      DTSBU981
00230      EXIT.                                                        DTSBU981
00231      EJECT                                                        DTSBU981
00232  P2300-READ-NEXT.                                                 DTSBU981
00233      READ WGH-FILE NEXT.                                          DTSBU981
00234                                                                   DTSBU981
00235      IF FILE-OK-88                                                DTSBU981
00236          MOVE FILE-REC  TO LINK-REC                               DTSBU981
00237      ELSE                                                         DTSBU981
00238      IF FILE-NO-REC-88                                            DTSBU981
00239          PERFORM S1100-NO-REC THRU S1100-EXIT                     DTSBU981
00240      ELSE                                                         DTSBU981
00241          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00242  P2300-EXIT.                                                      DTSBU981
00243      EXIT.                                                        DTSBU981
00244      EJECT                                                        DTSBU981
00245  P3100-WRITE.                                                     DTSBU981
00246      MOVE LINK-REC  TO FILE-REC.                                  DTSBU981
00247                                                                   DTSBU981
00248      WRITE FILE-REC.                                              DTSBU981
00249                                                                   DTSBU981
00250      IF FILE-OK-88                                                DTSBU981
00251          NEXT SENTENCE                                            DTSBU981
00252      ELSE                                                         DTSBU981
00253          IF FILE-DUP-REC-88                                       DTSBU981
00254              PERFORM S9400-SPEC-DISPLAY THRU S9400-EXIT           DTSBU981
00255          ELSE                                                     DTSBU981
00256              PERFORM S999-ABEND THRU S999-EXIT                    DTSBU981
00257          END-IF                                                   DTSBU981
00258      END-IF.                                                      DTSBU981
00259  P3100-EXIT.                                                      DTSBU981
00260      EXIT.                                                        DTSBU981
00261      EJECT                                                        DTSBU981
00262  P3200-REWRITE.                                                   DTSBU981
00263      MOVE LINK-REC  TO FILE-REC.                                  DTSBU981
00264                                                                   DTSBU981
00265      REWRITE FILE-REC.                                            DTSBU981
00266                                                                   DTSBU981
00267      IF FILE-OK-88                                                DTSBU981
00268          NEXT SENTENCE                                            DTSBU981
00269      ELSE                                                         DTSBU981
00270          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00271  P3200-EXIT.                                                      DTSBU981
00272      EXIT.                                                        DTSBU981
00273      EJECT                                                        DTSBU981
00274  P3300-DELETE.                                                    DTSBU981
00275      MOVE WWGH-KEY-AREA OF LINK-REC                               DTSBU981
00276        TO WWGH-KEY-AREA OF FILE-REC.                              DTSBU981
00277                                                                   DTSBU981
00278      DELETE WGH-FILE RECORD.                                      DTSBU981
00279                                                                   DTSBU981
00280      IF FILE-OK-88                                                DTSBU981
00281          NEXT SENTENCE                                            DTSBU981
00282      ELSE                                                         DTSBU981
00283          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU981
00284  P3300-EXIT.                                                      DTSBU981
00285      EXIT.                                                        DTSBU981
00286      EJECT                                                        DTSBU981
00287  S1100-NO-REC.                                                    DTSBU981
00288      SET L981-NO-REC-88 TO TRUE.                                  DTSBU981
00289  S1100-EXIT.                                                      DTSBU981
00290      EXIT.                                                        DTSBU981
00291      SKIP3                                                        DTSBU981
00292  S9100-PRE-DISPLAY.                                               DTSBU981
00293      DISPLAY ' '.                                                 DTSBU981
00294                                                                   DTSBU981
00295      DISPLAY ' '.                                                 DTSBU981
00296                                                                   DTSBU981
00297      DISPLAY '*** DTSBU981 PRE  TRACE DISPLAY ***'.               DTSBU981
00298                                                                   DTSBU981
00299      DISPLAY L981-MOD-NAME                                        DTSBU981
00300              ' = L981-MOD-NAME'.                                  DTSBU981
00301                                                                   DTSBU981
00302      DISPLAY L981-CMND-CD                                         DTSBU981
00303              ' = L981-CMND-CD'.                                   DTSBU981
00304                                                                   DTSBU981
00305      PERFORM S9300-REC-DISPLAY THRU S9300-EXIT.                   DTSBU981
00306  S9100-EXIT.                                                      DTSBU981
00307      EXIT.                                                        DTSBU981
00308      SKIP3                                                        DTSBU981
00309  S9200-POST-DISPLAY.                                              DTSBU981
00310      DISPLAY ' '.                                                 DTSBU981
00311                                                                   DTSBU981
00312      DISPLAY ' '.                                                 DTSBU981
00313                                                                   DTSBU981
00314      DISPLAY '*** DTSBU981 POST TRACE DISPLAY ***'.               DTSBU981
00315                                                                   DTSBU981
00316      DISPLAY L981-RESULT-IND                                      DTSBU981
00317              ' = L981-RESULT-IND'.                                DTSBU981
00318                                                                   DTSBU981
00319      PERFORM S9300-REC-DISPLAY THRU S9300-EXIT.                   DTSBU981
00320  S9200-EXIT.                                                      DTSBU981
00321      EXIT.                                                        DTSBU981
00322      SKIP3                                                        DTSBU981
00323  S9300-REC-DISPLAY.                                               DTSBU981
00324      DISPLAY ' '.                                                 DTSBU981
00325                                                                   DTSBU981
00326      MOVE 'WWGH'  TO WRK-REC-PREFIX.                              DTSBU981
00327      MOVE WRK-KEY-LENGTH TO L991-REQ-CHAR-CNT.                    DTSBU981
00328                                                                   DTSBU981
00329      MOVE WWGH-KEY-AREA OF LINK-REC TO L991-REQ-AREA.             DTSBU981
00330                                                                   DTSBU981
00331      PERFORM S991-HEX-FORMAT THRU S991-EXIT.                      DTSBU981
00332                                                                   DTSBU981
00333      DISPLAY 'REC TYPE = '                                        DTSBU981
00334              WRK-REC-PREFIX.                                      DTSBU981
00335                                                                   DTSBU981
00336      DISPLAY 'KEY AREA = '                                        DTSBU981
00337              L991-REPLY-HEX-1-AREA.                               DTSBU981
00338                                                                   DTSBU981
00339      DISPLAY '           '                                        DTSBU981
00340              L991-REPLY-HEX-2-AREA.                               DTSBU981
00341                                                                   DTSBU981
00342      DISPLAY '           '                                        DTSBU981
00343              L991-REPLY-AN-AREA.                                  DTSBU981
00344  S9300-EXIT.                                                      DTSBU981
00345      EXIT.                                                        DTSBU981
00346      EJECT                                                        DTSBU981
00347  S9400-SPEC-DISPLAY.                                              DTSBU981
00348      DISPLAY ' '.                                                 DTSBU981
00349                                                                   DTSBU981
00350      DISPLAY 'REC TYPE = WWGH'.                                   DTSBU981
00351                                                                   DTSBU981
00352      DISPLAY '*** DUPLICATE RECORD'.                              DTSBU981
00353                                                                   DTSBU981
00354      DISPLAY '*** CMND-CD = ' L981-CMND-CD.                       DTSBU981
00355                                                                   DTSBU981
00356      DISPLAY '*** FILE-STATUS = ' FILE-STATUS.                    DTSBU981
00357                                                                   DTSBU981
00358      MOVE WWGH-EMP-NO OF FILE-REC   TO WS-EMP-NO                  DTSBU981
00359      MOVE WWGH-YRQ    OF FILE-REC   TO WS-YRQ                     DTSBU981
00360      MOVE WWGH-SSN    OF FILE-REC   TO WS-SSN                     DTSBU981
00361                                                                   DTSBU981
00362      DISPLAY 'REC KEY : ' WS-KEY-AREA.                            DTSBU981
00363                                                                   DTSBU981
00364      MOVE WWGH-EARNINGS OF FILE-REC TO WS-EARNINGS                DTSBU981
00365                                                                   DTSBU981
00366      DISPLAY 'REC DATA: ' WS-DATA-AREA.                           DTSBU981
00367                                                                   DTSBU981
00368  S9400-EXIT.                                                      DTSBU981
00369      EXIT.                                                        DTSBU981
00370      EJECT                                                        DTSBU981
00371  S991-HEX-FORMAT.                                                 DTSBU981
00372      CALL 'DTSBU991' USING L991-LINK-AREA.                        DTSBU981
00373  S991-EXIT.                                                       DTSBU981
00374      EXIT.                                                        DTSBU981
00375      EJECT                                                        DTSBU981
00376  S999-ABEND.                                                      DTSBU981
00377      DISPLAY '*** I/O MODULE ABENDING'.                           DTSBU981
00378                                                                   DTSBU981
00379      DISPLAY '*** CMND-CD = ' L981-CMND-CD.                       DTSBU981
00380                                                                   DTSBU981
00381      DISPLAY '*** FILE-STATUS = ' FILE-STATUS.                    DTSBU981
00382                                                                   DTSBU981
00383      DISPLAY '*** CALLING MODULE = ' L981-MOD-NAME.               DTSBU981
00384                                                                   DTSBU981
00385      PERFORM S9300-REC-DISPLAY THRU S9300-EXIT.                   DTSBU981
00386                                                                   DTSBU981
00387      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBU981
00388  S999-EXIT.                                                       DTSBU981
00389      EXIT.                                                        DTSBU981
