00001  IDENTIFICATION DIVISION.                                         03/04/11
00002  PROGRAM-ID.             DTSBD150.                                DTSBD150
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV016
00004  DATE-WRITTEN.           JANUARY 1991.                            DTSBD150
00005  DATE-COMPILED.                                                   DTSBD150
00006      SKIP3                                                        DTSBD150
00007 *****                                                             DTSBD150
00008 *                                                                 DTSBD150
00009 *    FUNCTION:  PRE-UPDTE ACCOUNTING TRANSACTION COLLECTION       DTSBD150
00010 *               FILE SCAN.                                        DTSBD150
00011 *                                                                 DTSBD150
00012 *    MODIFICATION LOG:                                            DTSBD150
00013 *                                                                 DTSBD150
00014 *    03/02/92  INITIAL DEVELOPMENT.                               DTSBD150
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBD150
00016 *                                                                 DTSBD150
00017 *    05/09/95  AHDR-*-ITEM-CNT  WERE CHANGED TO  AHDR-*-TRAN-CNT. DTSBD150
00018 *              THEY NO LONGER INCLUDE THE CHECKS IN THE COUNTS.   DTSBD150
00019 *              WORK ORDER: CR076                PROGRAMMER: RHC   DTSBD150
00020 *                                                                 DTSBD150
00021 *    06/15/95  MODIFY P4200.                                      DTSBD150
00022 *              WORK ORDER: CR066                PROGRAMMER: EHH   DTSBD150
00023 *                                                                 DTSBD150
00024 *    12/31/96  ADDED 88 LEVEL TO DTSIAHDR FOR ELETRONIC FILER     DTSBD150
00025 *              BATCHES.  ONLY USED IN DTSBD140, SO TO SAVE MONEY  DTSBD150
00026 *              THIS PROGRAM WASN'T RECOMPILED.                    DTSBD150
00027 *              WORK ORDER:                      PROGRAMMER: MJA   DTSBD150
00028 *                                                                 DTSBD150
00029 *    10/09/1998  REVIEWED AND MODIFIED FOR DC.  IN DC, ALL        DTSBD150
00030 *                ACCOUNTING TRANSACTIONS IN A GIVEN BATCH ARE     DTSBD150
00031 *                RETAINED ON THE ATC FILE UNTIL ALL TRANSACTIONS  DTSBD150
00032 *                IN THE BATCH ARE PROCESSED SUCCESSFULLY - AT     DTSBD150
00033 *                WHICH POINT DTSBD180 DELETES, FROM THE ATC FILE, DTSBD150
00034 *                ALL RECORDS ASSOCIATED WITH THE BATCH.           DTSBD150
00035 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD150
00036 *                                                                 DTSBD150
00037 *    01/28/2002  MODIFIED FOR ANNUAL REPORT TRANSACTION (DTSIATX) DTSBD150
00038 *                REFERENCE: HOUSEHOLD           PROGRAMMER: GD    DTSBD150
00039 *                                                                 DTSBD150
00040 *    12/19/2005  RECOMPILED FOR NEW VERSION OF AHDR WITH BANK     DTSBD150
00041 *                BATCH NUMBER.                                    DTSBD150
00042 *                REFERENCE:                     PROGRAMMER: GD    DTSBD150
00043 *                                                                 DTSBD150
00044 *    02/23/2011  ADDED ADDITIONAL TESTS FOR RECEIVED DATE IN      DTSBD150
00045 *                P4200. IF RECEIVED DATE ON REPORT TRANSACTION    DTSBD150
00046 *                IS ZERO, AND RECEIVED DATE ON HEADER RECORD IS   DTSBD150
00047 *                WITHIN THE GRACE PERIOD, SET THE RECEIVED DATE   DTSBD150
00048 *                ON THE REPORT RECORD TO THE REPORT DUE DATE.     DTSBD150
00049 *                REFERENCE: LOCKBOX PROBLEMS    PROGRAMMER: GD    DTSBD150
00050 *                                                                 DTSBD150
00051 *                                                                 DTSBD150
00052 *  DESCRIPTION:                                                   DTSBD150
00053 *                                                                 DTSBD150
00054 *    FOR EACH AHDR RECORD ON THE ATC FILE:                        DTSBD150
00055 *                                                                 DTSBD150
00056 *    1)  VERIFY AND IF NECESSARY CORRECT AHDR-ATC-FILE-TRAN-CNT,  DTSBD150
00057 *        AHDR-ATC-FILE-REMIT-AMT, AND AHDR-BATCH-BALANCED-IND.    DTSBD150
00058 *        IF A CORRECTION IS MADE, THEN WRITE A R907 RECORD.       DTSBD150
00059 *                                                                 DTSBD150
00060 *        THIS FUNCTION IS PARANOID.  IF THE AHDR-ATC-FILE FIELDS  DTSBD150
00061 *        GET OUT OF SYNC WITH THE TRANSACTIONS IN THE BATCH,      DTSBD150
00062 *        THEN THIS LOGIC WILL SNAP THE AHDR-ATC-FILE FIELDS BACK  DTSBD150
00063 *        INTO BALANCE WITH THE ATC-FILE TRANSACTIONS IN THE BATCH.DTSBD150
00064 *                                                                 DTSBD150
00065 *                                                                 DTSBD150
00066 *    2)  IF AHDR-BATCH-BALANCED-YES-88 AND AHDR-BATCH-HELD-NO-88, DTSBD150
00067 *        THEN FOR EACH A*-NOT-PROCESSED-88 TRANSACTION IN THE     DTSBD150
00068 *        BATCH WRITE A T051 RECORD THRU S946-TRN-REC-O.           DTSBD150
00069 *        SET T051-ORIGIN TO 'DTSBD150', SET T051-SYS-DATE TO      DTSBD150
00070 *         THE SYSTEM DATE, SET T051-SYS-TIME TO THE SYSTEM-TIME.  DTSBD150
00071 *                                                                 DTSBD150
00072 *        AS THE T051 RECORDS ARE BEING WRITTEN:                   DTSBD150
00073 *                                                                 DTSBD150
00074 *          IF A***-RECEIVED-DATE = 0,                             DTSBD150
00075 *            THEN MOVE AHDR-RECEIVED-DATE TO A***-RECEIVED-DATE.  DTSBD150
00076 *                                                                 DTSBD150
00077 *          MOVE AHDR-DEPOSIT-DATE TO A***-DEPOSIT-DATE.           DTSBD150
00078 *                                                                 DTSBD150
00079 *                                                                 DTSBD150
00080 *    3)  IF AHDR-BATCH-BALANCED-NO-88 OR AHDR-BATCH-HELD-YES-88,  DTSBD150
00081 *        BYPASS THE BATCH (DO NOT WRITE T051 RECORDS).            DTSBD150
00082 *                                                                 DTSBD150
00083 *                                                                 DTSBD150
00084 *    TERMINATION:                                                 DTSBD150
00085 *                                                                 DTSBD150
00086 *      DISPLAY A FEW TERMINATION STATISTICS.  SEE DTSBD110 FOR    DTSBD150
00087 *      EXAMPLE OF FORMAT.  DISPLAY # OF AHDR RECORDS ENCOUNTERED, DTSBD150
00088 *      # OF BALANCED / NOT HELD AHDR RECORDS ENCOUNTERED, AND     DTSBD150
00089 *      # OF NOT BALANCED OR HELD AHDR RECORDS ENCOUNTERED.        DTSBD150
00090 *                                                                 DTSBD150
00091 *****                                                             DTSBD150
00092      SKIP3                                                        DTSBD150
00093  ENVIRONMENT DIVISION.                                            DTSBD150
00094      SKIP3                                                        DTSBD150
00095  DATA DIVISION.                                                   DTSBD150
00096      SKIP3                                                        DTSBD150
00097  FILE SECTION.                                                    DTSBD150
00098      SKIP3                                                        DTSBD150
00099  WORKING-STORAGE SECTION.                                         DTSBD150
000995 77  PAN-VALET PICTURE X(24) VALUE '016DTSBD150  03/04/11'.       DTSBD150
00100      SKIP3                                                        DTSBD150
00101  01  WRK-AREA.                                                    DTSBD150
00102      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +150.DTSBD150
00103                                                                   DTSBD150
00104      05  WRK-MODULE-ID               PIC  X(08)  VALUE 'DTSBD150'.DTSBD150
00105                                                                   DTSBD150
00106      05  WRK-GRACE-START                 PIC S9(09)       COMP-3. DTSBD150
00107      05  WRK-GRACE-END                   PIC S9(09)       COMP-3. DTSBD150
00108                                                                   DTSBD150
00109      05  WRK-WORK-DAY-CNT                PIC S9(04)       COMP.   DTSBD150
00110                                                                   DTSBD150
00111      05  WRK-AHDR-REC-CNT                PIC S9(07)       COMP-3. DTSBD150
00112                                                                   DTSBD150
00113      05  WRK-AHDR-BALANCED-CNT           PIC S9(07)       COMP-3. DTSBD150
00114                                                                   DTSBD150
00115      05  WRK-AHDR-NOT-BALANCED-CNT       PIC S9(07)       COMP-3. DTSBD150
00116                                                                   DTSBD150
00117      05  WRK-AHDR-HELD-CNT               PIC S9(07)       COMP-3. DTSBD150
00118                                                                   DTSBD150
00119      05  WRK-AHDR-NOT-HELD-CNT           PIC S9(07)       COMP-3. DTSBD150
00120                                                                   DTSBD150
00121      05  WRK-AHDR-PROCESSED-CNT          PIC S9(07)       COMP-3. DTSBD150
00122                                                                   DTSBD150
00123      05  WRK-AHDR-BYPASSED-CNT           PIC S9(07)       COMP-3. DTSBD150
00124                                                                   DTSBD150
00125      05  WRK-R907-REC-CNT                PIC S9(07)       COMP-3. DTSBD150
00126                                                                   DTSBD150
00127      05  WRK-T051-REC-CNT                PIC S9(07)       COMP-3. DTSBD150
00128                                                                   DTSBD150
00129                                                                   DTSBD150
00130      05  WRK-TRAN-CNT                    PIC S9(03)       COMP-3. DTSBD150
00131                                                                   DTSBD150
00132      05  WRK-REMIT-AMT                   PIC S9(09)V9(02) COMP-3. DTSBD150
00133      SKIP3                                                        DTSBD150
00134  01  WRK-INDICATORS.                                              DTSBD150
00135      05  ATC-BATCH-BREAK-IND             PIC  X(01) VALUE 'N'.    DTSBD150
00136                                                                   DTSBD150
00137      05  TRN-PROCESSED-IND               PIC  X(01).              DTSBD150
00138      SKIP3                                                        DTSBD150
00139  01  WRK-HOLD-FIELDS.                                             DTSBD150
00140      05  WRK-MSG-TEXT.                                            DTSBD150
00141          10  WRK-MSG-TEXT-1            PIC  X(07) VALUE 'BATCH: '.DTSBD150
00142          10  WRK-MSG-TEXT-2.                                      DTSBD150
00143              15  WRK-MSG-BATCH-NO      PIC  9(05).                DTSBD150
00144              15  FILLER                PIC  X(01)  VALUE SPACE.   DTSBD150
00145          10  WRK-MSG-TEXT-3            PIC  X(80).                DTSBD150
00146      EJECT                                                        DTSBD150
00147  01  L001-LINK-AREA.                                              DTSBD150
00148  ++INCLUDE DTSIL001                                               DTSBD150
00149      EJECT                                                        DTSBD150
00150  01  L003-LINK-AREA.                                              DTSBD150
00151  ++INCLUDE DTSIL003                                               DTSBD150
00152      EJECT                                                        DTSBD150
00153  01  L004-LINK-AREA.                                              DTSBD150
00154  ++INCLUDE DTSIL004                                               DTSBD150
00155      EJECT                                                        DTSBD150
00156  01  L005-LINK-AREA.                                              DTSBD150
00157  ++INCLUDE DTSIL005                                               DTSBD150
00158      EJECT                                                        DTSBD150
00159  01  L923-LINK-AREA.                                              DTSBD150
00160  ++INCLUDE DTSIL923                                               DTSBD150
00161      SKIP3                                                        DTSBD150
00162  01  ASKL-REC.                                                    DTSBD150
00163  ++INCLUDE DTSIASKL                                               DTSBD150
00164      SKIP3                                                        DTSBD150
00165  01  AHDR-REC.                                                    DTSBD150
00166  ++INCLUDE DTSIAHDR                                               DTSBD150
00167      SKIP3                                                        DTSBD150
00168  01  ARPT-REC.                                                    DTSBD150
00169  ++INCLUDE DTSIARPT                                               DTSBD150
00170      SKIP3                                                        DTSBD150
00171  01  AATX-REC.                                                    DTSBD150
00172  ++INCLUDE DTSIAATX                                               DTSBD150
00173      SKIP3                                                        DTSBD150
00174  01  APAY-REC.                                                    DTSBD150
00175  ++INCLUDE DTSIAPAY                                               DTSBD150
00176      SKIP3                                                        DTSBD150
00177  01  AADJ-REC.                                                    DTSBD150
00178  ++INCLUDE DTSIAADJ                                               DTSBD150
00179      EJECT                                                        DTSBD150
00180  01  T051-REC.                                                    DTSBD150
00181  ++INCLUDE DTSIT051                                               DTSBD150
00182      SKIP3                                                        DTSBD150
00183  01  R907-REC.                                                    DTSBD150
00184  ++INCLUDE DTSIR907                                               DTSBD150
00185      EJECT                                                        DTSBD150
00186  PROCEDURE DIVISION.                                              DTSBD150
00187                                                                   DTSBD150
00188                                                                   DTSBD150
00189      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD150
00190                                                                   DTSBD150
00191      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD150
00192                                                                   DTSBD150
00193      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD150
00194                                                                   DTSBD150
00195                                                                   DTSBD150
00196      GOBACK.                                                      DTSBD150
00197      EJECT                                                        DTSBD150
00198  I0000-INITIATE.                                                  DTSBD150
00199      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBD150
00200                                                                   DTSBD150
00201      PERFORM I2000-INITIALIZE-WRK      THRU I2000-EXIT.           DTSBD150
00202                                                                   DTSBD150
00203      MOVE LENGTH OF T051-REC TO T051-LENGTH.                      DTSBD150
00204                                                                   DTSBD150
00205      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      DTSBD150
00206  I0000-EXIT.                                                      DTSBD150
00207      EXIT.                                                        DTSBD150
00208      EJECT                                                        DTSBD150
00209  I1000-OPEN-FILES.                                                DTSBD150
00210      PERFORM S923-OPEN-UPDATE THRU S923-EXIT.                     DTSBD150
00211  I1000-EXIT.                                                      DTSBD150
00212      EXIT.                                                        DTSBD150
00213      EJECT                                                        DTSBD150
00214  I2000-INITIALIZE-WRK.                                            DTSBD150
00215      MOVE +0     TO    WRK-AHDR-REC-CNT                           DTSBD150
00216                        WRK-AHDR-BALANCED-CNT                      DTSBD150
00217                        WRK-AHDR-NOT-BALANCED-CNT                  DTSBD150
00218                        WRK-AHDR-HELD-CNT                          DTSBD150
00219                        WRK-AHDR-NOT-HELD-CNT                      DTSBD150
00220                        WRK-AHDR-PROCESSED-CNT                     DTSBD150
00221                        WRK-AHDR-BYPASSED-CNT                      DTSBD150
00222                        WRK-R907-REC-CNT                           DTSBD150
00223                        WRK-T051-REC-CNT.                          DTSBD150
00224                                                                   DTSBD150
00225                                                                   DTSBD150
00226      PERFORM S005-FROM-SYS THRU S005-EXIT.                        DTSBD150
00227  I2000-EXIT.                                                      DTSBD150
00228      EXIT.                                                        DTSBD150
00229      EJECT                                                        DTSBD150
00230  P0000-PROCESS.                                                   DTSBD150
00231      MOVE +0 TO AHDR-BATCH-NO                                     DTSBD150
00232                 AHDR-ITEM-NO.                                     DTSBD150
00233                                                                   DTSBD150
00234      PERFORM P1000-ATC-FILE THRU P1000-EXIT                       DTSBD150
00235         UNTIL L923-NO-REC-88.                                     DTSBD150
00236  P0000-EXIT.                                                      DTSBD150
00237      EXIT.                                                        DTSBD150
00238      EJECT                                                        DTSBD150
00239  P1000-ATC-FILE.                                                  DTSBD150
00240      ADD +1 TO AHDR-BATCH-NO.                                     DTSBD150
00241                                                                   DTSBD150
00242      MOVE AHDR-KEY-AREA TO ASKL-KEY-AREA.                         DTSBD150
00243                                                                   DTSBD150
00244      PERFORM S923-START-BROWSE THRU S923-EXIT.                    DTSBD150
00245                                                                   DTSBD150
00246      IF L923-NO-REC-88                                            DTSBD150
00247          GO TO P1000-EXIT.                                        DTSBD150
00248                                                                   DTSBD150
00249                                                                   DTSBD150
00250      ADD +1 TO WRK-AHDR-REC-CNT.                                  DTSBD150
00251                                                                   DTSBD150
00252                                                                   DTSBD150
00253      IF NOT ASKL-HDR-88                                           DTSBD150
00254          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD150
00255                                                                   DTSBD150
00256                                                                   DTSBD150
00257      MOVE ASKL-REC TO AHDR-REC.                                   DTSBD150
00258                                                                   DTSBD150
00259      MOVE 'N' TO ATC-BATCH-BREAK-IND.                             DTSBD150
00260                                                                   DTSBD150
00261      MOVE +0 TO WRK-TRAN-CNT                                      DTSBD150
00262                 WRK-REMIT-AMT.                                    DTSBD150
00263                                                                   DTSBD150
00264      PERFORM P2000-ATC-TRAN-DETAIL THRU P2000-EXIT                DTSBD150
00265         UNTIL L923-NO-REC-88 OR                                   DTSBD150
00266               ATC-BATCH-BREAK-IND = 'Y'.                          DTSBD150
00267                                                                   DTSBD150
00268                                                                   DTSBD150
00269      PERFORM P3000-VERIFY-ATC-FILE-FIELDS THRU P3000-EXIT.        DTSBD150
00270                                                                   DTSBD150
00271                                                                   DTSBD150
00272      IF AHDR-BATCH-BALANCED-YES-88                                DTSBD150
00273          ADD +1 TO WRK-AHDR-BALANCED-CNT                          DTSBD150
00274      ELSE                                                         DTSBD150
00275          ADD +1 TO WRK-AHDR-NOT-BALANCED-CNT.                     DTSBD150
00276                                                                   DTSBD150
00277                                                                   DTSBD150
00278      IF AHDR-BATCH-HELD-NO-88                                     DTSBD150
00279          ADD +1 TO WRK-AHDR-NOT-HELD-CNT                          DTSBD150
00280      ELSE                                                         DTSBD150
00281          ADD +1 TO WRK-AHDR-HELD-CNT.                             DTSBD150
00282                                                                   DTSBD150
00283                                                                   DTSBD150
00284      IF AHDR-BATCH-BALANCED-YES-88 AND AHDR-BATCH-HELD-NO-88      DTSBD150
00285         ADD +1 TO WRK-AHDR-PROCESSED-CNT                          DTSBD150
00286         PERFORM P4000-GENERATE-T051-REC THRU P4000-EXIT           DTSBD150
00287      ELSE                                                         DTSBD150
00288         ADD +1 TO WRK-AHDR-BYPASSED-CNT.                          DTSBD150
00289  P1000-EXIT.                                                      DTSBD150
00290      EXIT.                                                        DTSBD150
00291      EJECT                                                        DTSBD150
00292  P2000-ATC-TRAN-DETAIL.                                           DTSBD150
00293      PERFORM S923-READ-NEXT THRU S923-EXIT.                       DTSBD150
00294                                                                   DTSBD150
00295      IF (L923-NO-REC-88)                                          DTSBD150
00296              OR                                                   DTSBD150
00297         (ASKL-BATCH-NO NOT = AHDR-BATCH-NO)                       DTSBD150
00298          MOVE 'Y' TO ATC-BATCH-BREAK-IND                          DTSBD150
00299      ELSE                                                         DTSBD150
00300          PERFORM P2100-ACCUM-ACTUALS THRU P2100-EXIT.             DTSBD150
00301  P2000-EXIT.                                                      DTSBD150
00302      EXIT.                                                        DTSBD150
00303      EJECT                                                        DTSBD150
00304  P2100-ACCUM-ACTUALS.                                             DTSBD150
00305      IF ASKL-HDR-88                                               DTSBD150
00306          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD150
00307                                                                   DTSBD150
00308      ADD +1 TO WRK-TRAN-CNT.                                      DTSBD150
00309                                                                   DTSBD150
00310      IF ASKL-RPT-88                                               DTSBD150
00311          MOVE ASKL-REC TO ARPT-REC                                DTSBD150
00312          ADD ARPT-REMIT-AMT TO WRK-REMIT-AMT                      DTSBD150
00313      ELSE                                                         DTSBD150
00314      IF ASKL-PAY-88                                               DTSBD150
00315          MOVE ASKL-REC TO APAY-REC                                DTSBD150
00316          ADD APAY-REMIT-AMT TO WRK-REMIT-AMT                      DTSBD150
00317      ELSE                                                         DTSBD150
00318      IF ASKL-ATX-88                                               DTSBD150
00319          MOVE ASKL-REC TO AATX-REC                                DTSBD150
00320          ADD AATX-REMIT-AMT TO WRK-REMIT-AMT.                     DTSBD150
00321  P2100-EXIT.                                                      DTSBD150
00322      EXIT.                                                        DTSBD150
00323      EJECT                                                        DTSBD150
00324  P3000-VERIFY-ATC-FILE-FIELDS.                                    DTSBD150
00325      IF (AHDR-ATC-FILE-TRAN-CNT = WRK-TRAN-CNT)                   DTSBD150
00326                    AND                                            DTSBD150
00327         (AHDR-ATC-FILE-REMIT-AMT = WRK-REMIT-AMT)                 DTSBD150
00328          IF (AHDR-CONTROL-TRAN-CNT = AHDR-ATC-FILE-TRAN-CNT)      DTSBD150
00329                   AND                                             DTSBD150
00330             (AHDR-CONTROL-REMIT-AMT = AHDR-ATC-FILE-REMIT-AMT)    DTSBD150
00331              IF AHDR-BATCH-BALANCED-YES-88                        DTSBD150
00332                  GO TO P3000-EXIT                                 DTSBD150
00333              ELSE                                                 DTSBD150
00334                  NEXT SENTENCE                                    DTSBD150
00335          ELSE                                                     DTSBD150
00336              IF AHDR-BATCH-BALANCED-NO-88                         DTSBD150
00337                  GO TO P3000-EXIT                                 DTSBD150
00338              ELSE                                                 DTSBD150
00339                  NEXT SENTENCE                                    DTSBD150
00340      ELSE                                                         DTSBD150
00341          NEXT SENTENCE.                                           DTSBD150
00342                                                                   DTSBD150
00343                                                                   DTSBD150
00344      PERFORM P3400-GENERATE-R907-REC THRU P3400-EXIT.             DTSBD150
00345                                                                   DTSBD150
00346                                                                   DTSBD150
00347      PERFORM P3200-GET-BATCH-HDR THRU P3200-EXIT                  DTSBD150
00348                                                                   DTSBD150
00349                                                                   DTSBD150
00350      PERFORM P3300-UPDATE-BATCH-HDR THRU P3300-EXIT.              DTSBD150
00351  P3000-EXIT.                                                      DTSBD150
00352      EXIT.                                                        DTSBD150
00353      EJECT                                                        DTSBD150
00354  P3200-GET-BATCH-HDR.                                             DTSBD150
00355      MOVE AHDR-DOC-NO TO ASKL-DOC-NO.                             DTSBD150
00356                                                                   DTSBD150
00357      PERFORM S923-READ THRU S923-EXIT.                            DTSBD150
00358                                                                   DTSBD150
00359      IF L923-OK-88                                                DTSBD150
00360         MOVE ASKL-REC TO AHDR-REC                                 DTSBD150
00361      ELSE                                                         DTSBD150
00362         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD150
00363  P3200-EXIT.                                                      DTSBD150
00364      EXIT.                                                        DTSBD150
00365      EJECT                                                        DTSBD150
00366  P3300-UPDATE-BATCH-HDR.                                          DTSBD150
00367      MOVE WRK-TRAN-CNT TO AHDR-ATC-FILE-TRAN-CNT.                 DTSBD150
00368                                                                   DTSBD150
00369      MOVE WRK-REMIT-AMT TO AHDR-ATC-FILE-REMIT-AMT.               DTSBD150
00370                                                                   DTSBD150
00371      IF (AHDR-ATC-FILE-TRAN-CNT = AHDR-CONTROL-TRAN-CNT)          DTSBD150
00372                AND                                                DTSBD150
00373         (AHDR-ATC-FILE-REMIT-AMT = AHDR-CONTROL-REMIT-AMT)        DTSBD150
00374          SET AHDR-BATCH-BALANCED-YES-88 TO TRUE                   DTSBD150
00375      ELSE                                                         DTSBD150
00376          SET AHDR-BATCH-BALANCED-NO-88 TO TRUE.                   DTSBD150
00377                                                                   DTSBD150
00378                                                                   DTSBD150
00379      MOVE AHDR-REC TO ASKL-REC.                                   DTSBD150
00380                                                                   DTSBD150
00381      PERFORM S923-REWRITE THRU S923-EXIT.                         DTSBD150
00382  P3300-EXIT.                                                      DTSBD150
00383      EXIT.                                                        DTSBD150
00384      EJECT                                                        DTSBD150
00385  P3400-GENERATE-R907-REC.                                         DTSBD150
00386      IF WRK-TRAN-CNT NOT = AHDR-ATC-FILE-TRAN-CNT                 DTSBD150
00387         MOVE '201' TO R907-MSG-ID                                 DTSBD150
00388         MOVE 'AHDR-ATC-FILE-TRAN- CNT NOT = ACTUAL TRAN COUNT'    DTSBD150
00389           TO WRK-MSG-TEXT-3                                       DTSBD150
00390         PERFORM P3410-R907 THRU P3410-EXIT.                       DTSBD150
00391                                                                   DTSBD150
00392      IF WRK-REMIT-AMT NOT = AHDR-ATC-FILE-REMIT-AMT               DTSBD150
00393         MOVE '202' TO R907-MSG-ID                                 DTSBD150
00394         MOVE 'AHDR-ATC-FILE-REMIT-AMT NOT = ACTUAL REMIT AMOUNT'  DTSBD150
00395           TO WRK-MSG-TEXT-3                                       DTSBD150
00396         PERFORM P3410-R907 THRU P3410-EXIT.                       DTSBD150
00397                                                                   DTSBD150
00398      IF (AHDR-BATCH-BALANCED-NO-88)                               DTSBD150
00399                AND                                                DTSBD150
00400         (WRK-TRAN-CNT = AHDR-CONTROL-TRAN-CNT)                    DTSBD150
00401                AND                                                DTSBD150
00402         (WRK-REMIT-AMT = AHDR-CONTROL-REMIT-AMT)                  DTSBD150
00403         MOVE '203' TO R907-MSG-ID                                 DTSBD150
00404         MOVE                                                      DTSBD150
00405          'AHDR-BATCH-BALANCED-NO-88 WHEN BATCH ACTUALLY BALANCED' DTSBD150
00406           TO WRK-MSG-TEXT-3                                       DTSBD150
00407         PERFORM P3410-R907 THRU P3410-EXIT.                       DTSBD150
00408                                                                   DTSBD150
00409      IF (AHDR-BATCH-BALANCED-YES-88)                              DTSBD150
00410                AND                                                DTSBD150
00411         ((WRK-TRAN-CNT NOT = AHDR-CONTROL-TRAN-CNT)               DTSBD150
00412                OR                                                 DTSBD150
00413         (WRK-REMIT-AMT NOT = AHDR-CONTROL-REMIT-AMT))             DTSBD150
00414         MOVE '204' TO R907-MSG-ID                                 DTSBD150
00415         MOVE                                                      DTSBD150
00416      'AHDR-BATCH-BALANCED-YES-88 WHEN BATCH ACTUALLY NOT BALANCED'DTSBD150
00417           TO WRK-MSG-TEXT-3                                       DTSBD150
00418         PERFORM P3410-R907 THRU P3410-EXIT.                       DTSBD150
00419  P3400-EXIT.                                                      DTSBD150
00420      EXIT.                                                        DTSBD150
00421      SKIP3                                                        DTSBD150
00422  P3410-R907.                                                      DTSBD150
00423      MOVE +0 TO R907-EMP-NO.                                      DTSBD150
00424                                                                   DTSBD150
00425      MOVE WRK-MODULE-ID TO R907-MODULE-NAME.                      DTSBD150
00426                                                                   DTSBD150
00427      MOVE AHDR-BATCH-NO TO WRK-MSG-BATCH-NO.                      DTSBD150
00428                                                                   DTSBD150
00429      MOVE WRK-MSG-TEXT TO R907-MSG-TEXT.                          DTSBD150
00430                                                                   DTSBD150
00431      PERFORM S947-WRITE-R907 THRU S947-EXIT.                      DTSBD150
00432                                                                   DTSBD150
00433      ADD +1 TO WRK-R907-REC-CNT.                                  DTSBD150
00434  P3410-EXIT.                                                      DTSBD150
00435      EXIT.                                                        DTSBD150
00436      EJECT                                                        DTSBD150
00437  P4000-GENERATE-T051-REC.                                         DTSBD150
00438      MOVE AHDR-DOC-NO TO ASKL-DOC-NO.                             DTSBD150
00439                                                                   DTSBD150
00440      PERFORM S923-START-BROWSE THRU S923-EXIT.                    DTSBD150
00441                                                                   DTSBD150
00442      IF L923-NO-REC-88                                            DTSBD150
00443         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBD150
00444                                                                   DTSBD150
00445      PERFORM P4100-ATC-PROCESS THRU P4100-EXIT                    DTSBD150
00446          UNTIL (L923-NO-REC-88)                                   DTSBD150
00447                     OR                                            DTSBD150
00448                (ASKL-BATCH-NO NOT = AHDR-BATCH-NO).               DTSBD150
00449  P4000-EXIT.                                                      DTSBD150
00450      EXIT.                                                        DTSBD150
00451      EJECT                                                        DTSBD150
00452  P4100-ATC-PROCESS.                                               DTSBD150
00453      PERFORM S923-READ-NEXT THRU S923-EXIT.                       DTSBD150
00454                                                                   DTSBD150
00455      IF (L923-NO-REC-88)                                          DTSBD150
00456             OR                                                    DTSBD150
00457         (ASKL-BATCH-NO NOT = AHDR-BATCH-NO)                       DTSBD150
00458          GO TO P4100-EXIT.                                        DTSBD150
00459                                                                   DTSBD150
00460      MOVE 'Y' TO TRN-PROCESSED-IND.                               DTSBD150
00461                                                                   DTSBD150
00462      PERFORM P4200-FORMAT-T051-REC THRU P4200-EXIT.               DTSBD150
00463                                                                   DTSBD150
00464      IF TRN-PROCESSED-IND = 'Y'                                   DTSBD150
00465          GO TO P4100-EXIT.                                        DTSBD150
00466                                                                   DTSBD150
00467      PERFORM S946-WRITE-T051 THRU S946-EXIT.                      DTSBD150
00468                                                                   DTSBD150
00469      ADD +1 TO WRK-T051-REC-CNT.                                  DTSBD150
00470  P4100-EXIT.                                                      DTSBD150
00471      EXIT.                                                        DTSBD150
00472      EJECT                                                        DTSBD150
00473  P4200-FORMAT-T051-REC.                                           DTSBD150
00474      MOVE SPACE TO T051-ORIGIN.                                   DTSBD150
00475                                                                   DTSBD150
00476      MOVE L005-DATE TO T051-SYS-DATE.                             DTSBD150
00477                                                                   DTSBD150
00478      MOVE L005-TIME TO T051-SYS-TIME.                             DTSBD150
00479                                                                   DTSBD150
00480      IF ASKL-RPT-88                                               DTSBD150
00481          MOVE ASKL-REC TO ARPT-REC                                DTSBD150
00482          MOVE ARPT-EMP-NO TO T051-EMP-NO                          DTSBD150
00483          MOVE ARPT-RESPONSIBLE-OP-ID TO T051-ORIGIN               DTSBD150
00484          MOVE AHDR-DEPOSIT-DATE TO ARPT-DEPOSIT-DATE              DTSBD150
00485          IF ARPT-RECEIVED-DATE = +0                               DTSBD150
00486             IF ARPT-ORIG-88                                       DTSBD150
00487                PERFORM P4210-GRACE-PERIOD    THRU P4210-EXIT      DTSBD150
00488             ELSE                                                  DTSBD150
00489                MOVE AHDR-RECEIVED-DATE TO ARPT-RECEIVED-DATE      DTSBD150
00490             END-IF                                                DTSBD150
00491          END-IF                                                   DTSBD150
00492          IF ARPT-NOT-PROCESSED-88                                 DTSBD150
00493              MOVE 'N' TO TRN-PROCESSED-IND                        DTSBD150
00494          END-IF                                                   DTSBD150
00495          MOVE ARPT-REC TO T051-DATA-AREA                          DTSBD150
00496      ELSE                                                         DTSBD150
00497      IF ASKL-ATX-88                                               DTSBD150
00498          MOVE ASKL-REC TO AATX-REC                                DTSBD150
00499          MOVE AATX-EMP-NO TO T051-EMP-NO                          DTSBD150
00500          MOVE AATX-RESPONSIBLE-OP-ID TO T051-ORIGIN               DTSBD150
00501          MOVE AHDR-DEPOSIT-DATE TO AATX-DEPOSIT-DATE              DTSBD150
00502          IF AATX-RECEIVED-DATE = +0                               DTSBD150
00503              MOVE AHDR-RECEIVED-DATE TO AATX-RECEIVED-DATE        DTSBD150
00504          END-IF                                                   DTSBD150
00505          IF AATX-NOT-PROCESSED-88                                 DTSBD150
00506              MOVE 'N' TO TRN-PROCESSED-IND                        DTSBD150
00507          END-IF                                                   DTSBD150
00508          MOVE AATX-REC TO T051-DATA-AREA                          DTSBD150
00509      ELSE                                                         DTSBD150
00510      IF ASKL-PAY-88                                               DTSBD150
00511          MOVE ASKL-REC TO APAY-REC                                DTSBD150
00512          MOVE APAY-EMP-NO TO T051-EMP-NO                          DTSBD150
00513          MOVE APAY-RESPONSIBLE-OP-ID TO T051-ORIGIN               DTSBD150
00514          MOVE AHDR-DEPOSIT-DATE TO APAY-DEPOSIT-DATE              DTSBD150
00515          IF APAY-RECEIVED-DATE = +0                               DTSBD150
00516              MOVE AHDR-RECEIVED-DATE TO APAY-RECEIVED-DATE        DTSBD150
00517          END-IF                                                   DTSBD150
00518          IF APAY-NOT-PROCESSED-88                                 DTSBD150
00519              MOVE 'N' TO TRN-PROCESSED-IND                        DTSBD150
00520          END-IF                                                   DTSBD150
00521          MOVE APAY-REC TO T051-DATA-AREA                          DTSBD150
00522      ELSE                                                         DTSBD150
00523      IF ASKL-ADJ-88                                               DTSBD150
00524          MOVE ASKL-REC TO AADJ-REC                                DTSBD150
00525          MOVE AADJ-EMP-NO TO T051-EMP-NO                          DTSBD150
00526          MOVE AADJ-RESPONSIBLE-OP-ID TO T051-ORIGIN               DTSBD150
00527          MOVE AHDR-DEPOSIT-DATE TO AADJ-DEPOSIT-DATE              DTSBD150
00528          IF AADJ-RECEIVED-DATE = +0                               DTSBD150
00529              MOVE AHDR-RECEIVED-DATE TO AADJ-RECEIVED-DATE        DTSBD150
00530          END-IF                                                   DTSBD150
00531          IF AADJ-NOT-PROCESSED-88                                 DTSBD150
00532              MOVE 'N' TO TRN-PROCESSED-IND                        DTSBD150
00533          END-IF                                                   DTSBD150
00534          MOVE AADJ-REC TO T051-DATA-AREA                          DTSBD150
00535      ELSE                                                         DTSBD150
00536          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD150
00537                                                                   DTSBD150
00538      IF T051-ORIGIN-TRANSFER-88                                   DTSBD150
00539          NEXT SENTENCE                                            DTSBD150
00540      ELSE                                                         DTSBD150
00541          MOVE WRK-MODULE-ID TO T051-ORIGIN.                       DTSBD150
00542  P4200-EXIT.                                                      DTSBD150
00543      EXIT.                                                        DTSBD150
00544                                                                   DTSBD150
00545  P4210-GRACE-PERIOD.                                              DTSBD150
00546      PERFORM P4211-CALC-PERIOD         THRU P4211-EXIT            DTSBD150
00547      PERFORM P4212-SET-RCVD-DATE       THRU P4212-EXIT.           DTSBD150
00548                                                                   DTSBD150
00549  P4210-EXIT.                                                      DTSBD150
00550      EXIT.                                                        DTSBD150
00551                                                                   DTSBD150
00552  P4211-CALC-PERIOD.                                               DTSBD150
00553      MOVE ARPT-YRQ                     TO L004-QTR-5-9.           DTSBD150
00554      PERFORM S004-FROM-5               THRU S004-EXIT.            DTSBD150
00555      MOVE L004-QTR-DEFAULT-DUE-DATE    TO L001-FED-8-DATE-9.      DTSBD150
00556                                                                   DTSBD150
00557      PERFORM S001-FROM-FED-8           THRU S001-EXIT.            DTSBD150
00558      ADD +1                            TO L001-JUL-ABS-DAY.       DTSBD150
00559      PERFORM S001-FROM-ABS-DAY         THRU S001-EXIT.            DTSBD150
00560      MOVE L001-FED-8-DATE-9            TO WRK-GRACE-START.        DTSBD150
00561                                                                   DTSBD150
00562      MOVE +0                           TO WRK-WORK-DAY-CNT.       DTSBD150
00563                                                                   DTSBD150
00564      PERFORM UNTIL WRK-WORK-DAY-CNT > +3                          DTSBD150
00565         ADD +1                         TO L001-JUL-ABS-DAY        DTSBD150
00566         PERFORM S001-FROM-ABS-DAY      THRU S001-EXIT             DTSBD150
00567         MOVE L001-FED-8-DATE-9         TO L003-DATE               DTSBD150
00568         PERFORM S003-AGENCY-DAY        THRU S003-EXIT             DTSBD150
00569                                                                   DTSBD150
00570         IF L003-IS-WORK-DAY                                       DTSBD150
00571            ADD +1                      TO WRK-WORK-DAY-CNT        DTSBD150
00572         END-IF                                                    DTSBD150
00573      END-PERFORM.                                                 DTSBD150
00574                                                                   DTSBD150
00575      MOVE L001-FED-8-DATE-9            TO WRK-GRACE-END.          DTSBD150
00576                                                                   DTSBD150
00577  P4211-EXIT.                                                      DTSBD150
00578      EXIT.                                                        DTSBD150
00579                                                                   DTSBD150
00580  P4212-SET-RCVD-DATE.                                             DTSBD150
00581      IF  AHDR-RECEIVED-DATE >= WRK-GRACE-START                    DTSBD150
00582      AND AHDR-RECEIVED-DATE <= WRK-GRACE-END                      DTSBD150
00583         MOVE L004-QTR-DEFAULT-DUE-DATE TO ARPT-RECEIVED-DATE      DTSBD150
00584      ELSE                                                         DTSBD150
00585         MOVE AHDR-RECEIVED-DATE        TO ARPT-RECEIVED-DATE      DTSBD150
00586      END-IF.                                                      DTSBD150
00587                                                                   DTSBD150
00588  P4212-EXIT.                                                      DTSBD150
00589      EXIT.                                                        DTSBD150
00590                                                                   DTSBD150
00591  T0000-TERMINATE.                                                 DTSBD150
00592      DISPLAY ' '.                                                 DTSBD150
00593                                                                   DTSBD150
00594      DISPLAY '*** DTSBD150 TERMINATION STATISTICS ***'.           DTSBD150
00595                                                                   DTSBD150
00596      DISPLAY '       TOTAL NUMBER OF HEADER RECORDS ENCOUNTERED: 'DTSBD150
00597              WRK-AHDR-REC-CNT.                                    DTSBD150
00598                                                                   DTSBD150
00599      DISPLAY '    NUMBER OF BALANCED HEADER RECORDS ENCOUNTERED: 'DTSBD150
00600              WRK-AHDR-BALANCED-CNT.                               DTSBD150
00601                                                                   DTSBD150
00602      DISPLAY 'NUMBER OF NOT BALANCED HEADER RECORDS ENCOUNTERED: 'DTSBD150
00603              WRK-AHDR-NOT-BALANCED-CNT.                           DTSBD150
00604                                                                   DTSBD150
00605      DISPLAY '        NUMBER OF HELD HEADER RECORDS ENCOUNTERED: 'DTSBD150
00606              WRK-AHDR-HELD-CNT.                                   DTSBD150
00607                                                                   DTSBD150
00608      DISPLAY '    NUMBER OF NOT HELD HEADER RECORDS ENCOUNTERED: 'DTSBD150
00609              WRK-AHDR-NOT-HELD-CNT.                               DTSBD150
00610                                                                   DTSBD150
00611      DISPLAY '               NUMBER OF HEADER RECORDS PROCESSED: 'DTSBD150
00612              WRK-AHDR-PROCESSED-CNT.                              DTSBD150
00613                                                                   DTSBD150
00614      DISPLAY '                NUMBER OF HEADER RECORDS BYPASSED: 'DTSBD150
00615              WRK-AHDR-BYPASSED-CNT.                               DTSBD150
00616                                                                   DTSBD150
00617      DISPLAY ' '.                                                 DTSBD150
00618                                                                   DTSBD150
00619      DISPLAY '                   NUMBER OF T051 RECORDS CREATED: 'DTSBD150
00620              WRK-T051-REC-CNT.                                    DTSBD150
00621                                                                   DTSBD150
00622      DISPLAY ' '.                                                 DTSBD150
00623                                                                   DTSBD150
00624      DISPLAY '                   NUMBER OF R907 RECORDS CREATED: 'DTSBD150
00625              WRK-R907-REC-CNT.                                    DTSBD150
00626                                                                   DTSBD150
00627                                                                   DTSBD150
00628      PERFORM S923-CLOSE     THRU S923-EXIT.                       DTSBD150
00629                                                                   DTSBD150
00630      MOVE -1 TO T051-LENGTH.                                      DTSBD150
00631                                                                   DTSBD150
00632      PERFORM S946-WRITE-T051 THRU S946-EXIT.                      DTSBD150
00633                                                                   DTSBD150
00634      MOVE -1 TO R907-LENGTH.                                      DTSBD150
00635                                                                   DTSBD150
00636      PERFORM S947-WRITE-R907 THRU S947-EXIT.                      DTSBD150
00637      SKIP2                                                        DTSBD150
00638  T0000-EXIT.                                                      DTSBD150
00639      EXIT.                                                        DTSBD150
00640                                                                   DTSBD150
00641  S001-FROM-FED-8.                                                 DTSBD150
00642      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD150
00643      GO TO S001-DATE.                                             DTSBD150
00644                                                                   DTSBD150
00645  S001-FROM-CAL-8.                                                 DTSBD150
00646      SET L001-FROM-CAL-8 TO TRUE.                                 DTSBD150
00647      GO TO S001-DATE.                                             DTSBD150
00648                                                                   DTSBD150
00649  S001-FROM-ABS-DAY.                                               DTSBD150
00650      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD150
00651      GO TO S001-DATE.                                             DTSBD150
00652                                                                   DTSBD150
00653  S001-DATE.                                                       DTSBD150
00654      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD150
00655  S001-EXIT.                                                       DTSBD150
00656      EXIT.                                                        DTSBD150
00657                                                                   DTSBD150
00658  S003-AGENCY-DAY.                                                 DTSBD150
00659      SET L003-AGENCY-DAY TO TRUE.                                 DTSBD150
00660      GO TO S003-WORK-DAY.                                         DTSBD150
00661                                                                   DTSBD150
00662  S003-WORK-DAY.                                                   DTSBD150
00663      CALL 'DTSBU003' USING L003-LINK-AREA.                        DTSBD150
00664  S003-EXIT.                                                       DTSBD150
00665      EXIT.                                                        DTSBD150
00666                                                                   DTSBD150
00667  S004-FROM-5.                                                     DTSBD150
00668      SET L004-FROM-5        TO TRUE.                              DTSBD150
00669      GO TO S004-YRQ.                                              DTSBD150
00670                                                                   DTSBD150
00671  S004-FROM-DATE.                                                  DTSBD150
00672      SET L004-FROM-DATE     TO TRUE.                              DTSBD150
00673      GO TO S004-YRQ.                                              DTSBD150
00674                                                                   DTSBD150
00675  S004-FROM-ABS.                                                   DTSBD150
00676      SET L004-FROM-ABS      TO TRUE.                              DTSBD150
00677      GO TO S004-YRQ.                                              DTSBD150
00678                                                                   DTSBD150
00679  S004-YRQ.                                                        DTSBD150
00680      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD150
00681                                                                   DTSBD150
00682  S004-EXIT.                                                       DTSBD150
00683      EXIT.                                                        DTSBD150
00684                                                                   DTSBD150
00685  S005-FROM-SYS.                                                   DTSBD150
00686      SET L005-FROM-SYS TO TRUE.                                   DTSBD150
00687      GO TO S005-ABSTIME.                                          DTSBD150
00688                                                                   DTSBD150
00689  S005-ABSTIME.                                                    DTSBD150
00690      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBD150
00691  S005-EXIT.                                                       DTSBD150
00692      EXIT.                                                        DTSBD150
00693      SKIP3                                                        DTSBD150
00694  S923-OPEN-UPDATE.                                                DTSBD150
00695      SET L923-OPEN-UPDATE-88 TO TRUE.                             DTSBD150
00696      GO TO S923-ATC-IO.                                           DTSBD150
00697                                                                   DTSBD150
00698  S923-READ.                                                       DTSBD150
00699      SET L923-READ-88 TO TRUE.                                    DTSBD150
00700      GO TO S923-ATC-IO.                                           DTSBD150
00701                                                                   DTSBD150
00702  S923-START-BROWSE.                                               DTSBD150
00703      SET L923-START-BROWSE-88 TO TRUE.                            DTSBD150
00704      GO TO S923-ATC-IO.                                           DTSBD150
00705                                                                   DTSBD150
00706  S923-READ-NEXT.                                                  DTSBD150
00707      SET L923-READ-NEXT-88 TO TRUE.                               DTSBD150
00708      GO TO S923-ATC-IO.                                           DTSBD150
00709                                                                   DTSBD150
00710 *S923-WRITE.                                                      DTSBD150
00711 *****SET L923-WRITE-88 TO TRUE.                                   DTSBD150
00712 *****GO TO S923-ATC-IO.                                           DTSBD150
00713                                                                   DTSBD150
00714  S923-REWRITE.                                                    DTSBD150
00715      SET L923-REWRITE-88 TO TRUE.                                 DTSBD150
00716      GO TO S923-ATC-IO.                                           DTSBD150
00717                                                                   DTSBD150
00718 *S923-DELETE.                                                     DTSBD150
00719 *****SET L923-DELETE-88 TO TRUE.                                  DTSBD150
00720 *****GO TO S923-ATC-IO.                                           DTSBD150
00721                                                                   DTSBD150
00722  S923-CLOSE.                                                      DTSBD150
00723      SET L923-CLOSE-88 TO TRUE.                                   DTSBD150
00724      GO TO S923-ATC-IO.                                           DTSBD150
00725                                                                   DTSBD150
00726  S923-ATC-IO.                                                     DTSBD150
00727      CALL 'DTSBU923' USING L923-LINK-AREA                         DTSBD150
00728                            ASKL-REC.                              DTSBD150
00729  S923-EXIT.                                                       DTSBD150
00730      EXIT.                                                        DTSBD150
00731      SKIP3                                                        DTSBD150
00732  S946-WRITE-T051.                                                 DTSBD150
00733      CALL 'DTSBU946' USING T051-REC.                              DTSBD150
00734      GO TO S946-EXIT.                                             DTSBD150
00735                                                                   DTSBD150
00736  S946-EXIT.                                                       DTSBD150
00737      EXIT.                                                        DTSBD150
00738      SKIP3                                                        DTSBD150
00739  S947-WRITE-R907.                                                 DTSBD150
00740      CALL 'DTSBU947' USING R907-REC.                              DTSBD150
00741      GO TO S947-EXIT.                                             DTSBD150
00742                                                                   DTSBD150
00743  S947-EXIT.                                                       DTSBD150
00744      EXIT.                                                        DTSBD150
00745      SKIP3                                                        DTSBD150
00746  S999-ABEND.                                                      DTSBD150
00747      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD150
00748  S999-EXIT.                                                       DTSBD150
00749      EXIT.                                                        DTSBD150
