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