00001  IDENTIFICATION DIVISION.                                         06/17/13
00002  PROGRAM-ID.             DTSBD181.                                DTSBD181
00003  AUTHOR.                 NGC.                                        LV001
00004  DATE-WRITTEN.           JUNE 2013.                               DTSBD181
00005  DATE-COMPILED.                                                   DTSBD181
00006      SKIP3                                                        DTSBD181
00007 *****                                                             DTSBD181
00008 *                                                                 DTSBD181
00009 *    FUNCTION:  POST-UPDATE ACCOUNTING TRANSACTION COLLECTION     DTSBD181
00010 *               FILE: UPDATE LAST USED ITEM NUMBER.               DTSBD181
00011 *                                                                 DTSBD181
00012 *    MODIFICATION LOG:                                            DTSBD181
00013 *                                                                 DTSBD181
00014 *    06/04/2113  INITIAL DEVELOPMENT.                             DTSBD181
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSBD181
00016 *                                                                 DTSBD181
00017 *                                                                 DTSBD181
00018 *  DESCRIPTION:                                                   DTSBD181
00019 *                                                                 DTSBD181
00020 *    INITIATION:                                                  DTSBD181
00021 *                                                                 DTSBD181
00022 *      OPEN MASTER FILE (L910-OPEN-READ-88).                      DTSBD181
00023 *      OPEN ATC FILE (L923-OPEN-UPDATE-88).                       DTSBD181
00024 *                                                                 DTSBD181
00025 *      READ THE MHDR RECORD.                                      DTSBD181
00026 *      IF L910-NO-REC-88                                          DTSBD181
00027 *          ABEND THE MODULE.                                      DTSBD181
00028 *                                                                 DTSBD181
00029 *      MOVE MHDR-PRIOR-RUN-DATE TO R301-CURR-RUN-DATE.            DTSBD181
00030 *                                                                 DTSBD181
00031 *      MOVE +0 TO WORKING STORAGE COUNTERS.                       DTSBD181
00032 *                                                                 DTSBD181
00033 *                                                                 DTSBD181
00034 *    PROCESSING:                                                  DTSBD181
00035 *                                                                 DTSBD181
00036 *      FOR EACH AHDR RECORD ON THE ATC FILE:                      DTSBD181
00037 *                                                                 DTSBD181
00038 *      IF AHDR-BATCH-BALANCED-NO-88 OR AHDR-BATCH-HELD-YES-88     DTSBD181
00039 *          WRITE A R301 RECORD (WITH R301 FIELDS POPULATED FROM   DTSBD181
00040 *          AHDR FIELDS)                                           DTSBD181
00041 *      ELSE                                                       DTSBD181
00042 *          SCAN THRU THE ATC FILE, SUMMING PROCESSED AND NOT      DTSBD181
00043 *          PROCESSED TRANSACTIONS IN THIS BATCH;                  DTSBD181
00044 *          WRITE A R301 RECORD;                                   DTSBD181
00045 *          IF UNPROCESEED TRANSACTION RECORDS IN THIS BATCH       DTSBD181
00046 *             EXIST ON THE ATC FILE                               DTSBD181
00047 *              RESET AHDR FIELDS AND REWRITE THE AHDR RECORD      DTSBD181
00048 *          ELSE                                                   DTSBD181
00049 *              DELETE THE AHDR RECORD AND ALL ASSOCIATED          DTSBD181
00050 *              TRANSACTIONS.                                      DTSBD181
00051 *                                                                 DTSBD181
00052 *                                                                 DTSBD181
00053 *    TERMINATION:                                                 DTSBD181
00054 *                                                                 DTSBD181
00055 *      DISPLAY THE MODULE TERMINATION STATISTICS.                 DTSBD181
00056 *                                                                 DTSBD181
00057 *      CLOSE MASTER FILE, ATC FILE, S946-RPT-REC-O FILE.          DTSBD181
00058 *                                                                 DTSBD181
00059 *                                                                 DTSBD181
00060 *****                                                             DTSBD181
00061      SKIP3                                                        DTSBD181
00062  ENVIRONMENT DIVISION.                                            DTSBD181
00063  INPUT-OUTPUT SECTION.                                            DTSBD181
00064                                                                   DTSBD181
00065  FILE-CONTROL.                                                    DTSBD181
00066 *    SELECT SORT-FILE              ASSIGN TO DTSFSORT             DTSBD181
00067 *           FILE STATUS IS SORT-STATUS.                           DTSBD181
00068                                                                   DTSBD181
00069      SKIP3                                                        DTSBD181
00070  DATA DIVISION.                                                   DTSBD181
00071  FILE SECTION.                                                    DTSBD181
00072                                                                   DTSBD181
00073 *FD  BX217-BATCH-FILE                                             DTSBD181
00074 *    RECORDING MODE IS F                                          DTSBD181
00075 *    BLOCK CONTAINS 0 RECORDS                                     DTSBD181
00076 *    LABEL RECORDS ARE OMITTED.                                   DTSBD181
00077 *                                                                 DTSBD181
00078 *01  BX217-REC               PIC X(148).                          DTSBD181
00079      SKIP3                                                        DTSBD181
00080  WORKING-STORAGE SECTION.                                         DTSBD181
000805 77  PAN-VALET PICTURE X(24) VALUE '001DTSBD181  06/17/13'.       DTSBD181
00081  77  PAN-VALET PICTURE X(24) VALUE '001DTSBD181  06/17/13'.       DTSBD181
00082  77  PAN-VALET PICTURE X(24) VALUE '022DTSBD181  06/05/13'.       DTSBD181
00083  77  PAN-VALET PICTURE X(24) VALUE '019DTSBD180  10/03/11'.       DTSBD181
00084      SKIP3                                                        DTSBD181
00085  01  WRK-AREA.                                                    DTSBD181
00086      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +181.DTSBD181
00087                                                                   DTSBD181
00088      05  WRK-MODULE-ID               PIC  X(08)  VALUE 'DTSBD181'.DTSBD181
00089                                                                   DTSBD181
00090      05  BX217-STATUS                    PIC  X(02).              DTSBD181
00091          88  BX217-STATUS-OK-88            VALUE '00'.            DTSBD181
00092                                                                   DTSBD181
00093      05  WRK-AHDR-REC-CNT                PIC S9(07)       COMP-3  DTSBD181
00094                                            VALUE +0.              DTSBD181
00095                                                                   DTSBD181
00096      05  WRK-AHDR-UPD-CNT                PIC S9(07)       COMP-3  DTSBD181
00097                                            VALUE +0.              DTSBD181
00098                                                                   DTSBD181
00099      05  WRK-LAST-USED-ITEM-NO           PIC S9(03)       COMP-3. DTSBD181
00100                                                                   DTSBD181
00101                                                                   DTSBD181
00102  01  WRK-INDICATORS.                                              DTSBD181
00103      05  ATC-BATCH-BREAK-IND             PIC  X(01).              DTSBD181
00104                                                                   DTSBD181
00105                                                                   DTSBD181
00106                                                                   DTSBD181
00107      EJECT                                                        DTSBD181
00108  01  L001-LINK-AREA.                                              DTSBD181
00109  ++INCLUDE DTSIL001                                               DTSBD181
00110      SKIP3                                                        DTSBD181
00111  01  L910-LINK-AREA.                                              DTSBD181
00112  ++INCLUDE DTSIL910                                               DTSBD181
00113      SKIP3                                                        DTSBD181
00114  01  MSKL-REC.                                                    DTSBD181
00115  ++INCLUDE DTSIMSKL                                               DTSBD181
00116      SKIP3                                                        DTSBD181
00117  01  MHDR-REC.                                                    DTSBD181
00118  ++INCLUDE DTSIMHDR                                               DTSBD181
00119      EJECT                                                        DTSBD181
00120  01  MRPT-REC.                                                    DTSBD181
00121  ++INCLUDE DTSIMRPT                                               DTSBD181
00122      EJECT                                                        DTSBD181
00123  01  MPAY-REC.                                                    DTSBD181
00124  ++INCLUDE DTSIMPAY                                               DTSBD181
00125      EJECT                                                        DTSBD181
00126  01  MADJ-REC.                                                    DTSBD181
00127  ++INCLUDE DTSIMADJ                                               DTSBD181
00128      EJECT                                                        DTSBD181
00129  01  L923-LINK-AREA.                                              DTSBD181
00130  ++INCLUDE DTSIL923                                               DTSBD181
00131      SKIP3                                                        DTSBD181
00132  01  ASKL-REC.                                                    DTSBD181
00133  ++INCLUDE DTSIASKL                                               DTSBD181
00134      SKIP3                                                        DTSBD181
00135  01  AHDR-REC.                                                    DTSBD181
00136  ++INCLUDE DTSIAHDR                                               DTSBD181
00137      SKIP3                                                        DTSBD181
00138  01  ARPT-REC.                                                    DTSBD181
00139  ++INCLUDE DTSIARPT                                               DTSBD181
00140      SKIP3                                                        DTSBD181
00141  01  AATX-REC.                                                    DTSBD181
00142  ++INCLUDE DTSIAATX                                               DTSBD181
00143      SKIP3                                                        DTSBD181
00144  01  APAY-REC.                                                    DTSBD181
00145  ++INCLUDE DTSIAPAY                                               DTSBD181
00146      SKIP3                                                        DTSBD181
00147  01  AADJ-REC.                                                    DTSBD181
00148  ++INCLUDE DTSIAADJ                                               DTSBD181
00149      EJECT                                                        DTSBD181
00150  PROCEDURE DIVISION.                                              DTSBD181
00151                                                                   DTSBD181
00152      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD181
00153                                                                   DTSBD181
00154      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD181
00155                                                                   DTSBD181
00156      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD181
00157                                                                   DTSBD181
00158                                                                   DTSBD181
00159      GOBACK.                                                      DTSBD181
00160      EJECT                                                        DTSBD181
00161  I0000-INITIATE.                                                  DTSBD181
00162      PERFORM I1000-OPEN-FILES THRU I1000-EXIT.                    DTSBD181
00163                                                                   DTSBD181
00164      PERFORM I2000-INITIALIZE-WRK THRU I2000-EXIT.                DTSBD181
00165                                                                   DTSBD181
00166  I0000-EXIT.                                                      DTSBD181
00167      EXIT.                                                        DTSBD181
00168      EJECT                                                        DTSBD181
00169  I1000-OPEN-FILES.                                                DTSBD181
00170      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD181
00171                                                                   DTSBD181
00172 *&   PERFORM S923-OPEN-READ   THRU S923-EXIT.                     DTSBD181
00173      PERFORM S923-OPEN-UPDATE THRU S923-EXIT.                     DTSBD181
00174                                                                   DTSBD181
00175                                                                   DTSBD181
00176  I1000-EXIT.                                                      DTSBD181
00177      EXIT.                                                        DTSBD181
00178      EJECT                                                        DTSBD181
00179  I2000-INITIALIZE-WRK.                                            DTSBD181
00180      MOVE +0 TO WRK-AHDR-REC-CNT.                                 DTSBD181
00181                                                                   DTSBD181
00182      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBD181
00183                                                                   DTSBD181
00184      MOVE +0 TO MHDR-EMP-NO.                                      DTSBD181
00185                                                                   DTSBD181
00186      SET MHDR-HDR-88 TO TRUE.                                     DTSBD181
00187                                                                   DTSBD181
00188      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD181
00189                                                                   DTSBD181
00190      PERFORM S910-READ THRU S910-EXIT.                            DTSBD181
00191                                                                   DTSBD181
00192      IF L910-NO-REC-88                                            DTSBD181
00193         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD181
00194                                                                   DTSBD181
00195      MOVE MSKL-REC TO MHDR-REC.                                   DTSBD181
00196                                                                   DTSBD181
00197  I2000-EXIT.                                                      DTSBD181
00198      EXIT.                                                        DTSBD181
00199                                                                   DTSBD181
00200  P0000-PROCESS.                                                   DTSBD181
00201      MOVE +0 TO AHDR-BATCH-NO                                     DTSBD181
00202                 AHDR-ITEM-NO.                                     DTSBD181
00203                                                                   DTSBD181
00204      PERFORM P1000-ATC-FILE THRU P1000-EXIT                       DTSBD181
00205         UNTIL L923-NO-REC-88.                                     DTSBD181
00206  P0000-EXIT.                                                      DTSBD181
00207      EXIT.                                                        DTSBD181
00208      EJECT                                                        DTSBD181
00209  P1000-ATC-FILE.                                                  DTSBD181
00210      ADD +1 TO AHDR-BATCH-NO.                                     DTSBD181
00211                                                                   DTSBD181
00212      MOVE 'N'               TO ATC-BATCH-BREAK-IND.               DTSBD181
00213                                                                   DTSBD181
00214      MOVE AHDR-KEY-AREA TO ASKL-KEY-AREA.                         DTSBD181
00215                                                                   DTSBD181
00216      PERFORM S923-START-BROWSE THRU S923-EXIT.                    DTSBD181
00217                                                                   DTSBD181
00218      IF L923-NO-REC-88                                            DTSBD181
00219          GO TO P1000-EXIT.                                        DTSBD181
00220                                                                   DTSBD181
00221                                                                   DTSBD181
00222      IF NOT ASKL-HDR-88                                           DTSBD181
00223          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD181
00224                                                                   DTSBD181
00225                                                                   DTSBD181
00226      MOVE ASKL-REC TO AHDR-REC.                                   DTSBD181
00227                                                                   DTSBD181
00228      MOVE +0                  TO WRK-LAST-USED-ITEM-NO.           DTSBD181
00229      ADD +1 TO WRK-AHDR-REC-CNT.                                  DTSBD181
00230                                                                   DTSBD181
00231      PERFORM P2000-ATC-DETAIL THRU P2000-EXIT                     DTSBD181
00232         UNTIL L923-NO-REC-88  OR                                  DTSBD181
00233               ATC-BATCH-BREAK-IND = 'Y'.                          DTSBD181
00234                                                                   DTSBD181
00235      IF WRK-LAST-USED-ITEM-NO > AHDR-LAST-USED-ITEM-NO            DTSBD181
00236         PERFORM P4000-UPDATE-BATCH-HDR  THRU P4000-EXIT           DTSBD181
00237      END-IF.                                                      DTSBD181
00238                                                                   DTSBD181
00239  P1000-EXIT.                                                      DTSBD181
00240      EXIT.                                                        DTSBD181
00241                                                                   DTSBD181
00242  P2000-ATC-DETAIL.                                                DTSBD181
00243      PERFORM S923-READ-NEXT          THRU S923-EXIT.              DTSBD181
00244                                                                   DTSBD181
00245      IF (L923-NO-REC-88)                                          DTSBD181
00246              OR                                                   DTSBD181
00247         (ASKL-BATCH-NO NOT = AHDR-BATCH-NO)                       DTSBD181
00248          MOVE 'Y' TO ATC-BATCH-BREAK-IND                          DTSBD181
00249      ELSE                                                         DTSBD181
00250          PERFORM P2100-ACCUM-ACTUALS THRU P2100-EXIT.             DTSBD181
00251  P2000-EXIT.                                                      DTSBD181
00252      EXIT.                                                        DTSBD181
00253      EJECT                                                        DTSBD181
00254  P2100-ACCUM-ACTUALS.                                             DTSBD181
00255      IF ASKL-HDR-88                                               DTSBD181
00256         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD181
00257                                                                   DTSBD181
00258      EVALUATE TRUE                                                DTSBD181
00259        WHEN ASKL-RPT-88                                           DTSBD181
00260          MOVE ASKL-REC                   TO ARPT-REC              DTSBD181
00261          IF ARPT-PROCESSED-DATE > ZERO                            DTSBD181
00262             PERFORM P3000-RPT-LAST-ITEM  THRU P3000-EXIT          DTSBD181
00263          END-IF                                                   DTSBD181
00264                                                                   DTSBD181
00265        WHEN ASKL-ATX-88                                           DTSBD181
00266          MOVE ASKL-REC                   TO AATX-REC              DTSBD181
00267          IF AATX-PROCESSED-DATE > ZERO                            DTSBD181
00268             PERFORM P3100-ATX-LAST-ITEM  THRU P3100-EXIT          DTSBD181
00269          END-IF                                                   DTSBD181
00270                                                                   DTSBD181
00271        WHEN ASKL-PAY-88                                           DTSBD181
00272          MOVE ASKL-REC                   TO APAY-REC              DTSBD181
00273          IF APAY-PROCESSED-DATE > ZERO                            DTSBD181
00274             PERFORM P3200-PAY-LAST-ITEM  THRU P3200-EXIT          DTSBD181
00275          END-IF                                                   DTSBD181
00276                                                                   DTSBD181
00277        WHEN ASKL-ADJ-88                                           DTSBD181
00278          MOVE ASKL-REC                   TO AADJ-REC              DTSBD181
00279          IF AADJ-PROCESSED-DATE > ZERO                            DTSBD181
00280             PERFORM P3300-ADJ-LAST-ITEM  THRU P3300-EXIT          DTSBD181
00281          END-IF                                                   DTSBD181
00282                                                                   DTSBD181
00283      END-EVALUATE.                                                DTSBD181
00284                                                                   DTSBD181
00285  P2100-EXIT.                                                      DTSBD181
00286      EXIT.                                                        DTSBD181
00287                                                                   DTSBD181
00288  P3000-RPT-LAST-ITEM.                                             DTSBD181
00289 *    DISPLAY 'P3000' ARPT-BATCH-NO ' ' ARPT-ITEM-NO               DTSBD181
00290 *       '  ' ARPT-YRQ '  ' ARPT-RPT-TYPE                          DTSBD181
00291      MOVE LOW-VALUES           TO MRPT-KEY-AREA                   DTSBD181
00292      MOVE ARPT-EMP-NO          TO MRPT-EMP-NO                     DTSBD181
00293      MOVE ARPT-YRQ             TO MRPT-YRQ                        DTSBD181
00294      SET MRPT-RPT-88           TO TRUE.                           DTSBD181
00295      MOVE +0                   TO MRPT-BATCH-NO                   DTSBD181
00296                                   MRPT-ITEM-NO.                   DTSBD181
00297      MOVE MRPT-KEY-AREA        TO MSKL-KEY-AREA.                  DTSBD181
00298                                                                   DTSBD181
00299      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBD181
00300      PERFORM UNTIL L910-NO-REC-88                                 DTSBD181
00301         MOVE MSKL-REC            TO MRPT-REC                      DTSBD181
00302         IF MRPT-BATCH-NO = ARPT-BATCH-NO                          DTSBD181
00303            IF MRPT-ITEM-NO > WRK-LAST-USED-ITEM-NO                DTSBD181
00304               MOVE MRPT-ITEM-NO   TO WRK-LAST-USED-ITEM-NO        DTSBD181
00305            END-IF                                                 DTSBD181
00306         END-IF                                                    DTSBD181
00307         PERFORM S910-READ-NEXT    THRU S910-EXIT                  DTSBD181
00308      END-PERFORM.                                                 DTSBD181
00309                                                                   DTSBD181
00310  P3000-EXIT.                                                      DTSBD181
00311      EXIT.                                                        DTSBD181
00312                                                                   DTSBD181
00313  P3100-ATX-LAST-ITEM.                                             DTSBD181
00314 *    DISPLAY 'P3100  ' AATX-BATCH-NO ' ' AATX-ITEM-NO             DTSBD181
00315 *       '  ' AATX-YRQ '  ' AATX-RPT-TYPE                          DTSBD181
00316      MOVE LOW-VALUES           TO MRPT-KEY-AREA                   DTSBD181
00317      MOVE AATX-EMP-NO          TO MRPT-EMP-NO                     DTSBD181
00318      MOVE AATX-YRQ             TO MRPT-YRQ                        DTSBD181
00319      SET MRPT-RPT-88           TO TRUE.                           DTSBD181
00320      MOVE +0                   TO MRPT-BATCH-NO                   DTSBD181
00321                                   MRPT-ITEM-NO.                   DTSBD181
00322      MOVE MRPT-KEY-AREA        TO MSKL-KEY-AREA.                  DTSBD181
00323                                                                   DTSBD181
00324      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBD181
00325      PERFORM UNTIL L910-NO-REC-88                                 DTSBD181
00326         MOVE MSKL-REC            TO MRPT-REC                      DTSBD181
00327         IF MRPT-BATCH-NO = AATX-BATCH-NO                          DTSBD181
00328            IF MRPT-ITEM-NO > WRK-LAST-USED-ITEM-NO                DTSBD181
00329               MOVE MRPT-ITEM-NO   TO WRK-LAST-USED-ITEM-NO        DTSBD181
00330            END-IF                                                 DTSBD181
00331         END-IF                                                    DTSBD181
00332         PERFORM S910-READ-NEXT    THRU S910-EXIT                  DTSBD181
00333      END-PERFORM.                                                 DTSBD181
00334                                                                   DTSBD181
00335  P3100-EXIT.                                                      DTSBD181
00336      EXIT.                                                        DTSBD181
00337                                                                   DTSBD181
00338  P3200-PAY-LAST-ITEM.                                             DTSBD181
00339 *    DISPLAY 'P3200 ' APAY-BATCH-NO ' ' APAY-ITEM-NO              DTSBD181
00340 *       '  ' APAY-PAY-TYPE                                        DTSBD181
00341      MOVE LOW-VALUES           TO MPAY-KEY-AREA.                  DTSBD181
00342      MOVE APAY-EMP-NO          TO MPAY-EMP-NO.                    DTSBD181
00343      SET MPAY-PAY-88           TO TRUE.                           DTSBD181
00344      MOVE APAY-BATCH-NO        TO MPAY-BATCH-NO                   DTSBD181
00345      MOVE APAY-ITEM-NO         TO MPAY-ITEM-NO.                   DTSBD181
00346      MOVE MPAY-KEY-AREA        TO MSKL-KEY-AREA.                  DTSBD181
00347                                                                   DTSBD181
00348      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBD181
00349      PERFORM UNTIL L910-NO-REC-88                                 DTSBD181
00350         MOVE MSKL-REC            TO MPAY-REC                      DTSBD181
00351         IF MPAY-BATCH-NO = APAY-BATCH-NO                          DTSBD181
00352            IF MPAY-ITEM-NO > WRK-LAST-USED-ITEM-NO                DTSBD181
00353               MOVE MPAY-ITEM-NO   TO WRK-LAST-USED-ITEM-NO        DTSBD181
00354            END-IF                                                 DTSBD181
00355         END-IF                                                    DTSBD181
00356         PERFORM S910-READ-NEXT    THRU S910-EXIT                  DTSBD181
00357      END-PERFORM.                                                 DTSBD181
00358                                                                   DTSBD181
00359  P3200-EXIT.                                                      DTSBD181
00360      EXIT.                                                        DTSBD181
00361                                                                   DTSBD181
00362  P3300-ADJ-LAST-ITEM.                                             DTSBD181
00363 *    DISPLAY 'P3300 ' AADJ-BATCH-NO ' ' AADJ-ITEM-NO              DTSBD181
00364 *       '  ' AADJ-ADJ-TYPE                                        DTSBD181
00365      MOVE LOW-VALUES           TO MADJ-KEY-AREA.                  DTSBD181
00366      MOVE AADJ-EMP-NO          TO MADJ-EMP-NO.                    DTSBD181
00367      SET MADJ-ADJ-88           TO TRUE.                           DTSBD181
00368      MOVE AADJ-BATCH-NO        TO MADJ-BATCH-NO                   DTSBD181
00369      MOVE AADJ-ITEM-NO         TO MADJ-ITEM-NO.                   DTSBD181
00370      MOVE MADJ-KEY-AREA        TO MSKL-KEY-AREA.                  DTSBD181
00371                                                                   DTSBD181
00372      PERFORM S910-START-BROWSE   THRU S910-EXIT.                  DTSBD181
00373      PERFORM UNTIL L910-NO-REC-88                                 DTSBD181
00374         MOVE MSKL-REC            TO MADJ-REC                      DTSBD181
00375         IF MADJ-BATCH-NO = AADJ-BATCH-NO                          DTSBD181
00376            IF MADJ-ITEM-NO > WRK-LAST-USED-ITEM-NO                DTSBD181
00377               MOVE MADJ-ITEM-NO   TO WRK-LAST-USED-ITEM-NO        DTSBD181
00378            END-IF                                                 DTSBD181
00379         END-IF                                                    DTSBD181
00380         PERFORM S910-READ-NEXT    THRU S910-EXIT                  DTSBD181
00381      END-PERFORM.                                                 DTSBD181
00382                                                                   DTSBD181
00383  P3300-EXIT.                                                      DTSBD181
00384      EXIT.                                                        DTSBD181
00385                                                                   DTSBD181
00386  P4000-UPDATE-BATCH-HDR.                                          DTSBD181
00387      DISPLAY 'BD181 LAST ITEM1: ' AHDR-BATCH-NO                   DTSBD181
00388         '  '  AHDR-LAST-USED-ITEM-NO.                             DTSBD181
00389                                                                   DTSBD181
00390      MOVE WRK-LAST-USED-ITEM-NO   TO AHDR-LAST-USED-ITEM-NO.      DTSBD181
00391                                                                   DTSBD181
00392      DISPLAY 'BD181 LAST ITEM2: ' AHDR-BATCH-NO                   DTSBD181
00393         '  ' AHDR-LAST-USED-ITEM-NO.                              DTSBD181
00394                                                                   DTSBD181
00395      MOVE AHDR-REC TO ASKL-REC.                                   DTSBD181
00396                                                                   DTSBD181
00397      PERFORM S923-REWRITE THRU S923-EXIT.                         DTSBD181
00398                                                                   DTSBD181
00399  P4000-EXIT.                                                      DTSBD181
00400      EXIT.                                                        DTSBD181
00401                                                                   DTSBD181
00402  T0000-TERMINATE.                                                 DTSBD181
00403      DISPLAY ' '.                                                 DTSBD181
00404                                                                   DTSBD181
00405      DISPLAY '*** DTSBD181 TERMINATION STATISTICS ***'.           DTSBD181
00406                                                                   DTSBD181
00407      DISPLAY '    HEADER RECORDS FOUND  : '                       DTSBD181
00408              WRK-AHDR-REC-CNT.                                    DTSBD181
00409      DISPLAY '    HEADER RECORDS UPDATED: '                       DTSBD181
00410              WRK-AHDR-UPD-CNT.                                    DTSBD181
00411                                                                   DTSBD181
00412      DISPLAY ' '.                                                 DTSBD181
00413                                                                   DTSBD181
00414                                                                   DTSBD181
00415      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD181
00416                                                                   DTSBD181
00417      PERFORM S923-CLOSE THRU S923-EXIT.                           DTSBD181
00418                                                                   DTSBD181
00419                                                                   DTSBD181
00420                                                                   DTSBD181
00421  T0000-EXIT.                                                      DTSBD181
00422      EXIT.                                                        DTSBD181
00423      EJECT                                                        DTSBD181
00424  S001-FROM-FED-8.                                                 DTSBD181
00425      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD181
00426      GO TO S001-DATE.                                             DTSBD181
00427                                                                   DTSBD181
00428  S001-FROM-ABS-DAY.                                               DTSBD181
00429      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD181
00430      GO TO S001-DATE.                                             DTSBD181
00431                                                                   DTSBD181
00432  S001-DATE.                                                       DTSBD181
00433      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD181
00434  S001-EXIT.                                                       DTSBD181
00435      EXIT.                                                        DTSBD181
00436                                                                   DTSBD181
00437  S910-OPEN-READ.                                                  DTSBD181
00438      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD181
00439      GO TO S910-MSTR-IO.                                          DTSBD181
00440                                                                   DTSBD181
00441  S910-READ.                                                       DTSBD181
00442      SET L910-READ-88 TO TRUE.                                    DTSBD181
00443      GO TO S910-MSTR-IO.                                          DTSBD181
00444                                                                   DTSBD181
00445  S910-START-BROWSE.                                               DTSBD181
00446      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD181
00447      GO TO S910-MSTR-IO.                                          DTSBD181
00448                                                                   DTSBD181
00449  S910-READ-NEXT.                                                  DTSBD181
00450      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD181
00451      GO TO S910-MSTR-IO.                                          DTSBD181
00452                                                                   DTSBD181
00453 *S910-COUNT.                                                      DTSBD181
00454 *****SET L910-COUNT-88 TO TRUE.                                   DTSBD181
00455 *****GO TO S910-MSTR-IO.                                          DTSBD181
00456                                                                   DTSBD181
00457  S910-CLOSE.                                                      DTSBD181
00458      SET L910-CLOSE-88 TO TRUE.                                   DTSBD181
00459      GO TO S910-MSTR-IO.                                          DTSBD181
00460                                                                   DTSBD181
00461  S910-MSTR-IO.                                                    DTSBD181
00462      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD181
00463                            MSKL-REC.                              DTSBD181
00464  S910-EXIT.                                                       DTSBD181
00465      EXIT.                                                        DTSBD181
00466      SKIP3                                                        DTSBD181
00467  S923-OPEN-UPDATE.                                                DTSBD181
00468      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSBD181
00469      GO TO S923-ATC-IO.                                           DTSBD181
00470                                                                   DTSBD181
00471  S923-OPEN-READ.                                                  DTSBD181
00472      SET L923-OPEN-READ-88   TO TRUE.                             DTSBD181
00473      GO TO S923-ATC-IO.                                           DTSBD181
00474                                                                   DTSBD181
00475  S923-READ.                                                       DTSBD181
00476      SET L923-READ-88 TO TRUE.                                    DTSBD181
00477      GO TO S923-ATC-IO.                                           DTSBD181
00478                                                                   DTSBD181
00479  S923-START-BROWSE.                                               DTSBD181
00480      SET L923-START-BROWSE-88 TO TRUE.                            DTSBD181
00481      GO TO S923-ATC-IO.                                           DTSBD181
00482                                                                   DTSBD181
00483  S923-READ-NEXT.                                                  DTSBD181
00484      SET L923-READ-NEXT-88 TO TRUE.                               DTSBD181
00485      GO TO S923-ATC-IO.                                           DTSBD181
00486                                                                   DTSBD181
00487 *S923-WRITE.                                                      DTSBD181
00488 *****SET L923-WRITE-88 TO TRUE.                                   DTSBD181
00489 *****GO TO S923-ATC-IO.                                           DTSBD181
00490                                                                   DTSBD181
00491  S923-REWRITE.                                                    DTSBD181
00492      SET L923-REWRITE-88 TO TRUE.                                 DTSBD181
00493      GO TO S923-ATC-IO.                                           DTSBD181
00494                                                                   DTSBD181
00495  S923-DELETE.                                                     DTSBD181
00496      SET L923-DELETE-88 TO TRUE.                                  DTSBD181
00497      GO TO S923-ATC-IO.                                           DTSBD181
00498                                                                   DTSBD181
00499  S923-CLOSE.                                                      DTSBD181
00500      SET L923-CLOSE-88 TO TRUE.                                   DTSBD181
00501      GO TO S923-ATC-IO.                                           DTSBD181
00502                                                                   DTSBD181
00503  S923-ATC-IO.                                                     DTSBD181
00504      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSBD181
00505                            ASKL-REC.                              DTSBD181
00506  S923-EXIT.                                                       DTSBD181
00507      EXIT.                                                        DTSBD181
00508      SKIP3                                                        DTSBD181
00509  S999-ABEND.                                                      DTSBD181
00510      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD181
00511  S999-EXIT.                                                       DTSBD181
00512      EXIT.                                                        DTSBD181
