00001  IDENTIFICATION DIVISION.                                         09/30/98
00002  PROGRAM-ID.             DTSBU927.                                DTSBU927
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           FEBRUARY 1992.                           DTSBU927
00005  DATE-COMPILED.                                                   DTSBU927
00006      SKIP3                                                        DTSBU927
00007 *****                                                             DTSBU927
00008 *                                                                 DTSBU927
00009 *    FUNCTION:  BATCH TRANSACTION COLLECTION FILE OUTPUT.         DTSBU927
00010 *                                                                 DTSBU927
00011 *                                                                 DTSBU927
00012 *    MODIFICATION LOG:                                            DTSBU927
00013 *                                                                 DTSBU927
00014 *    02/14/92  INITIAL DEVELOPMENT.                               DTSBU927
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBU927
00016 *                                                                 DTSBU927
00017 *    09/30/1998  REVIEWED AND MODIFIED FOR DC.                       CL**2
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00019 *                                                                    CL**2
00020 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00021 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00022 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00023 *                                                                 DTSBU927
00024 *                                                                 DTSBU927
00025 *    DESCRIPTION:                                                 DTSBU927
00026 *                                                                 DTSBU927
00027 *        DTSBU927 PERFORMS ALL REQUIRED BATCH TRANSACTION            CL**2
00028 *        COLLECTION FILE OUTPUT.                                  DTSBU927
00029 *                                                                 DTSBU927
00030 *                                                                 DTSBU927
00031 *    GENERAL SPECIFICATIONS:                                      DTSBU927
00032 *                                                                 DTSBU927
00033 *        IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE       DTSBU927
00034 *        MODULE.                                                  DTSBU927
00035 *                                                                 DTSBU927
00036 *        IF A FILE-STATUS OF OTHER THAN '00' IS                   DTSBU927
00037 *        ENCOUNTERED, THEN ABEND PROCESSING.                      DTSBU927
00038 *                                                                 DTSBU927
00039 *                                                                 DTSBU927
00040 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSBU927
00041 *                                                                 DTSBU927
00042 *    OPEN-UPDATE                                                  DTSBU927
00043 *                                                                 DTSBU927
00044 *        MOVE +0 TO WRK-BTC-REC-CNT.                              DTSBU927
00045 *                                                                 DTSBU927
00046 *                                                                 DTSBU927
00047 *    CLOSE                                                        DTSBU927
00048 *                                                                 DTSBU927
00049 *      DISPLAY '*** '                                             DTSBU927
00050 *              WRK-BTC-REC-CNT                                    DTSBU927
00051 *              ' DTSFBTCO RECORDS WRITTEN'.                          CL**2
00052 *                                                                 DTSBU927
00053 *                                                                 DTSBU927
00054 *    WRITE                                                        DTSBU927
00055 *                                                                 DTSBU927
00056 *        IF RVAR-LENGTH OF FILE-REC < RLEN-MIN-LENGTH             DTSBU927
00057 *                 OR                                              DTSBU927
00058 *           RVAR-LENGTH OF FILE-REC > RLEN-MAX-LENGTH             DTSBU927
00059 *            ABEND PROCESSING.                                    DTSBU927
00060 *                                                                 DTSBU927
00061 *        VAR-CHAR-CNT MUST BE SET BEFORE THE MOVE FROM            DTSBU927
00062 *        FILE-REC TO LINK-REC.                                    DTSBU927
00063 *                                                                 DTSBU927
00064 *          VAR-CHAR-CNT = RVAR-LENGTH OF FILE-REC - 2.            DTSBU927
00065 *                                                                 DTSBU927
00066 *        ADD +1 TO WRK-BTC-REC-CNT.                               DTSBU927
00067 *                                                                 DTSBU927
00068 *****                                                             DTSBU927
00069      SKIP3                                                        DTSBU927
00070  ENVIRONMENT DIVISION.                                            DTSBU927
00071      SKIP2                                                        DTSBU927
00072  INPUT-OUTPUT SECTION.                                            DTSBU927
00073                                                                      CL**2
00074  FILE-CONTROL.                                                    DTSBU927
00075      SELECT BTC-FILE ASSIGN TO DTSFBTCO                              CL**2
00076          FILE STATUS IS FILE-STATUS.                              DTSBU927
00077      SKIP3                                                        DTSBU927
00078  DATA DIVISION.                                                   DTSBU927
00079      SKIP3                                                        DTSBU927
00080  FILE SECTION.                                                    DTSBU927
00081      SKIP3                                                        DTSBU927
00082  FD  BTC-FILE                                                     DTSBU927
00083      RECORDING MODE IS V                                          DTSBU927
00084      BLOCK CONTAINS 0 RECORDS.                                    DTSBU927
00085                                                                      CL**2
00086  01  FILE-REC.                                                    DTSBU927
00087  ++INCLUDE DTSIRVAR                                                  CL**2
00088      SKIP3                                                        DTSBU927
00089  01  RSK1-REC.                                                    DTSBU927
00090  ++INCLUDE DTSIRSK1                                                  CL**2
00091      EJECT                                                        DTSBU927
00092  WORKING-STORAGE SECTION.                                         DTSBU927
000925 77  PAN-VALET PICTURE X(24) VALUE '002DTSBU927  09/30/98'.       DTSBU927
00093      SKIP3                                                        DTSBU927
00094  01  WRK-AREA.                                                    DTSBU927
00095      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +927.DTSBU927
00096                                                                      CL**2
00097      05  VAR-CHAR-CNT                PIC S9(04)  COMP.            DTSBU927
00098                                                                      CL**2
00099      05  WRK-REC-CNT                 PIC S9(07)  COMP-3.          DTSBU927
00100                                                                      CL**2
00101      05  FILE-STATUS                 PIC  X(02).                  DTSBU927
00102          88  FILE-OK-88                  VALUE '00'.              DTSBU927
00103 *********88  FILE-VERIFY-88              VALUE '97'.              DTSBU927
00104      EJECT                                                        DTSBU927
00105  01  RLEN-LENGTH-LITERALS.                                        DTSBU927
00106  ++INCLUDE DTSIRLEN                                                  CL**2
00107      EJECT                                                        DTSBU927
00108  LINKAGE SECTION.                                                 DTSBU927
00109      SKIP3                                                        DTSBU927
00110  01  L927-LINK-AREA.                                              DTSBU927
00111  ++INCLUDE DTSIL927                                                  CL**2
00112      EJECT                                                        DTSBU927
00113  01  LINK-REC.                                                    DTSBU927
00114  ++INCLUDE DTSIRVAR                                                  CL**2
00115      EJECT                                                        DTSBU927
00116  PROCEDURE DIVISION USING L927-LINK-AREA                          DTSBU927
00117                           LINK-REC.                               DTSBU927
00118      SKIP2                                                        DTSBU927
00119      IF L927-TRACE-88                                             DTSBU927
00120          PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT.               DTSBU927
00121                                                                      CL**2
00122      SET L927-OK-88 TO TRUE.                                      DTSBU927
00123                                                                      CL**2
00124      IF L927-WRITE-88                                             DTSBU927
00125          PERFORM P3100-WRITE THRU P3100-EXIT                      DTSBU927
00126      ELSE                                                         DTSBU927
00127      IF L927-OPEN-UPDATE-88                                       DTSBU927
00128          PERFORM P1100-OPEN-UPDATE THRU P1100-EXIT                DTSBU927
00129      ELSE                                                         DTSBU927
00130      IF L927-CLOSE-88                                             DTSBU927
00131          PERFORM P1200-CLOSE THRU P1200-EXIT                      DTSBU927
00132      ELSE                                                         DTSBU927
00133          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU927
00134                                                                      CL**2
00135      IF L927-TRACE-88                                             DTSBU927
00136          PERFORM S9200-POST-DISPLAY THRU S9200-EXIT.              DTSBU927
00137                                                                      CL**2
00138                                                                      CL**2
00139      GOBACK.                                                      DTSBU927
00140      EJECT                                                        DTSBU927
00141  P1100-OPEN-UPDATE.                                               DTSBU927
00142      OPEN OUTPUT BTC-FILE.                                        DTSBU927
00143                                                                      CL**2
00144      IF FILE-OK-88                                                DTSBU927
00145          NEXT SENTENCE                                            DTSBU927
00146      ELSE                                                         DTSBU927
00147          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU927
00148                                                                      CL**2
00149      MOVE +0 TO WRK-REC-CNT.                                      DTSBU927
00150  P1100-EXIT.                                                      DTSBU927
00151      EXIT.                                                        DTSBU927
00152      SKIP3                                                        DTSBU927
00153  P1200-CLOSE.                                                     DTSBU927
00154      CLOSE BTC-FILE.                                              DTSBU927
00155                                                                      CL**2
00156      IF NOT FILE-OK-88                                            DTSBU927
00157          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU927
00158                                                                      CL**2
00159      DISPLAY '*** '                                               DTSBU927
00160              WRK-REC-CNT                                          DTSBU927
00161              ' DTSFBTCO RECORDS WRITTEN'.                            CL**2
00162  P1200-EXIT.                                                      DTSBU927
00163      EXIT.                                                        DTSBU927
00164      EJECT                                                        DTSBU927
00165  P3100-WRITE.                                                     DTSBU927
00166      IF (RVAR-LENGTH OF LINK-REC < RLEN-MIN-LENGTH)               DTSBU927
00167              OR                                                   DTSBU927
00168         (RVAR-LENGTH OF LINK-REC > RLEN-MAX-LENGTH)               DTSBU927
00169          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU927
00170                                                                      CL**2
00171      COMPUTE VAR-CHAR-CNT = RVAR-LENGTH OF LINK-REC - 2.          DTSBU927
00172                                                                      CL**2
00173      MOVE LINK-REC TO FILE-REC.                                   DTSBU927
00174                                                                      CL**2
00175      WRITE FILE-REC.                                              DTSBU927
00176                                                                      CL**2
00177      IF NOT FILE-OK-88                                            DTSBU927
00178          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU927
00179                                                                      CL**2
00180      ADD +1 TO WRK-REC-CNT.                                       DTSBU927
00181  P3100-EXIT.                                                      DTSBU927
00182      EXIT.                                                        DTSBU927
00183      EJECT                                                        DTSBU927
00184  S9100-PRE-DISPLAY.                                               DTSBU927
00185      DISPLAY ' '.                                                 DTSBU927
00186                                                                      CL**2
00187      DISPLAY ' '.                                                 DTSBU927
00188                                                                      CL**2
00189      DISPLAY '*** DTSBU927 PRE  TRACE DISPLAY ***'.                  CL**2
00190                                                                      CL**2
00191      DISPLAY L927-MOD-NAME                                        DTSBU927
00192              ' = L927-MOD-NAME'.                                  DTSBU927
00193                                                                      CL**2
00194      DISPLAY L927-CMND-CD                                         DTSBU927
00195              ' = L927-CMND-CD'.                                   DTSBU927
00196                                                                      CL**2
00197      DISPLAY RVAR-LENGTH OF LINK-REC                              DTSBU927
00198              ' = RVAR-LENGTH OF LINK-REC'.                        DTSBU927
00199                                                                      CL**2
00200      DISPLAY RVAR-CHAR OF LINK-REC (1)                            DTSBU927
00201              RVAR-CHAR OF LINK-REC(2)                             DTSBU927
00202              RVAR-CHAR OF LINK-REC(3)                             DTSBU927
00203              ' = REC-TYPE OF LINK-REC'.                           DTSBU927
00204  S9100-EXIT.                                                      DTSBU927
00205      EXIT.                                                        DTSBU927
00206      SKIP3                                                        DTSBU927
00207  S9200-POST-DISPLAY.                                              DTSBU927
00208      DISPLAY ' '.                                                 DTSBU927
00209                                                                      CL**2
00210      DISPLAY '*** DTSBU927 POST TRACE DISPLAY ***'.                  CL**2
00211                                                                      CL**2
00212      DISPLAY L927-RESULT-IND                                      DTSBU927
00213              ' = L927-RESULT-IND'.                                DTSBU927
00214  S9200-EXIT.                                                      DTSBU927
00215      EXIT.                                                        DTSBU927
00216      EJECT                                                        DTSBU927
00217  S999-ABEND.                                                      DTSBU927
00218      DISPLAY '*** I/O MODULE ABENDING'.                           DTSBU927
00219                                                                      CL**2
00220      DISPLAY '*** CMND-CD = ' L927-CMND-CD.                       DTSBU927
00221                                                                      CL**2
00222      DISPLAY '*** FILE-STATUS = ' FILE-STATUS.                    DTSBU927
00223                                                                      CL**2
00224      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00225  S999-EXIT.                                                       DTSBU927
00226      EXIT.                                                        DTSBU927
