00001  IDENTIFICATION DIVISION.                                         11/22/04
00002  PROGRAM-ID.             DTSBU962.                                DTSBU962
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV005
00004  DATE-WRITTEN.           OCTOBER 1994.                            DTSBU962
00005  DATE-COMPILED.                                                   DTSBU962
00006      SKIP3                                                        DTSBU962
00007 *****                                                             DTSBU962
00008 *                                                                 DTSBU962
00009 *    FUNCTION:  SEQUENTIAL MASTER FILE OUTPUT.                    DTSBU962
00010 *                                                                 DTSBU962
00011 *                                                                 DTSBU962
00012 *    MODIFICATION LOG:                                            DTSBU962
00013 *                                                                 DTSBU962
00014 *    10/28/94  INITIAL DEVELOPMENT.   COPIED FROM MACBU962        DTSBU962
00015 *              WORK ORDER:                      PROGRAMMER: ZL1   DTSBU962
00016 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU962
00017 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU962
00018 *              REFERENCE RFP: #XXX              PROGRAMMER: XXX   DTSBU962
00019 *                                                                 DTSBU962
00020 *                                                                 DTSBU962
00021 *    DESCRIPTION:                                                 DTSBU962
00022 *                                                                 DTSBU962
00023 *        DTSBU962 PERFORMS ALL REQUIRED SEQUENTIAL (TAPE)         DTSBU962
00024 *                 MASTER FILE OUTPUT.                             DTSBU962
00025 *                                                                 DTSBU962
00026 *                 THE "SEQUENTIAL" MASTER FILE WILL USUSALLY      DTSBU962
00027 *                 BE THE ARCHIVED MASTER FILE.                    DTSBU962
00028 *                                                                 DTSBU962
00029 *                 RECORDS RESIDING ON THE SEQUENTIAL MASTER       DTSBU962
00030 *                 FILE ARE NOT STORED IN A COMPRESSED FORMAT.     DTSBU962
00031 *                 WITH COMPRESSION BUILT INTO THE TAPE SUBSYSTEM, DTSBU962
00032 *                 COMPESSION IN THE APPLICATION WOULD BE A        DTSBU962
00033 *                 WASTE OF CPU CYCLES.                            DTSBU962
00034 *                                                                 DTSBU962
00035 *                                                                 DTSBU962
00036 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSBU962
00037 *                                                                 DTSBU962
00038 *    OPEN UPDATE.                                                 DTSBU962
00039 *        OPEN OUTPUT.                                             DTSBU962
00040 *                                                                 DTSBU962
00041 *    CLOSE                                                        DTSBU962
00042 *                                                                 DTSBU962
00043 *    WRITE                                                        DTSBU962
00044 *                                                                 DTSBU962
00045 *                                                                 DTSBU962
00046 *****                                                             DTSBU962
00047      SKIP3                                                        DTSBU962
00048  ENVIRONMENT DIVISION.                                            DTSBU962
00049      SKIP2                                                        DTSBU962
00050  INPUT-OUTPUT SECTION.                                            DTSBU962
00051                                                                   DTSBU962
00052  FILE-CONTROL.                                                    DTSBU962
00053      SELECT MST-FILE ASSIGN TO DTSFMSTO                           DTSBU962
00054          FILE STATUS IS FILE-STATUS.                              DTSBU962
00055      SKIP3                                                        DTSBU962
00056  DATA DIVISION.                                                   DTSBU962
00057      SKIP3                                                        DTSBU962
00058  FILE SECTION.                                                    DTSBU962
00059      SKIP3                                                        DTSBU962
00060  FD  MST-FILE                                                     DTSBU962
00061      RECORDING MODE IS V                                          DTSBU962
00062      BLOCK CONTAINS 0 CHARACTERS                                  DTSBU962
00063      RECORD IS VARYING DEPENDING ON MST-REC-LEN.                  DTSBU962
00064                                                                   DTSBU962
00065  01  FILE-REC.                                                    DTSBU962
00066  ++INCLUDE DTSIMSKL                                               DTSBU962
00067                                                                   DTSBU962
00068  01  FILE-MIN-LENGTH-REC         PIC  X(21).                      DTSBU962
00069                                                                   DTSBU962
00070  01  FILE-MAX-LENGTH-REC         PIC  X(4092).                    DTSBU962
00071      EJECT                                                        DTSBU962
00072  WORKING-STORAGE SECTION.                                         DTSBU962
000725 77  PAN-VALET PICTURE X(24) VALUE '005DTSBU962  11/22/04'.       DTSBU962
00073      SKIP3                                                        DTSBU962
00074  01  WRK-AREA.                                                    DTSBU962
00075      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +962.DTSBU962
00076                                                                   DTSBU962
00077      05  MST-REC-LEN                 PIC  9(04)  COMP.            DTSBU962
00078                                                                   DTSBU962
00079      05  WRK-REC-CNT                 PIC S9(07)  COMP-3.          DTSBU962
00080                                                                   DTSBU962
00081      05  FILE-STATUS                 PIC  X(02).                  DTSBU962
00082          88  FILE-OK-88                  VALUE '00'.              DTSBU962
00083          88  FILE-NO-REC-88              VALUE '10'.              DTSBU962
00084                                                                   DTSBU962
00085      05  WRK-REC-PREFIX              PIC  X(04).                  DTSBU962
00086                                                                   DTSBU962
00087      05  WRK-REC-LENGTH              PIC S9(04)  COMP.            DTSBU962
00088                                                                   DTSBU962
00089      05  WRK-DATA-LENGTH             PIC S9(04)  COMP.            DTSBU962
00090                                                                   DTSBU962
00091      05  OCC-COUNT-START             PIC S9(04)  COMP.            DTSBU962
00092                                                                   DTSBU962
00093      05  WRK-KEY-FILLER-START        PIC S9(04)  COMP.            DTSBU962
00094                                                                   DTSBU962
00095      05  WRK-KEY-FILLER-LENGTH       PIC S9(04)  COMP.            DTSBU962
00096                                                                   DTSBU962
00097      05  OCC-COUNT-X                 PIC  X(02).                  DTSBU962
00098      05  OCC-COUNT REDEFINES OCC-COUNT-X                          DTSBU962
00099                                      PIC S9(04)  COMP.            DTSBU962
00100      EJECT                                                        DTSBU962
00101  01  L991-LINK-AREA.                                              DTSBU962
00102  ++INCLUDE DTSIL991                                               DTSBU962
00103      EJECT                                                        DTSBU962
00104  01  MLEN-LENGTH-LITERALS.                                        DTSBU962
00105  ++INCLUDE DTSIMLEN                                               DTSBU962
00106      EJECT                                                        DTSBU962
00107  LINKAGE SECTION.                                                 DTSBU962
00108      SKIP3                                                        DTSBU962
00109  01  L962-LINK-AREA.                                              DTSBU962
00110  ++INCLUDE DTSIL962                                               DTSBU962
00111      EJECT                                                        DTSBU962
00112  01  LINK-REC.                                                    DTSBU962
00113  ++INCLUDE DTSIMSKL                                               DTSBU962
00114      EJECT                                                        DTSBU962
00115  PROCEDURE DIVISION USING L962-LINK-AREA                          DTSBU962
00116                           LINK-REC.                               DTSBU962
00117                                                                   DTSBU962
00118                                                                   DTSBU962
00119      IF L962-TRACE-88                                             DTSBU962
00120          PERFORM S9100-PRE-DISPLAY THRU S9100-EXIT.               DTSBU962
00121                                                                   DTSBU962
00122      SET L962-OK-88 TO TRUE.                                      DTSBU962
00123                                                                   DTSBU962
00124      IF L962-WRITE-88                                             DTSBU962
00125          PERFORM P2300-WRITE THRU P2300-EXIT                      DTSBU962
00126      ELSE                                                         DTSBU962
00127      IF L962-OPEN-UPDATE-88                                       DTSBU962
00128          PERFORM P1100-OPEN-UPDATE THRU P1100-EXIT                DTSBU962
00129      ELSE                                                         DTSBU962
00130      IF L962-CLOSE-88                                             DTSBU962
00131          PERFORM P1200-CLOSE THRU P1200-EXIT                      DTSBU962
00132      ELSE                                                         DTSBU962
00133          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00134                                                                   DTSBU962
00135      IF L962-TRACE-88                                             DTSBU962
00136          PERFORM S9200-POST-DISPLAY THRU S9200-EXIT.              DTSBU962
00137                                                                   DTSBU962
00138                                                                   DTSBU962
00139      GOBACK.                                                      DTSBU962
00140      EJECT                                                        DTSBU962
00141  P1100-OPEN-UPDATE.                                               DTSBU962
00142      OPEN OUTPUT MST-FILE.                                        DTSBU962
00143                                                                   DTSBU962
00144      IF FILE-OK-88                                                DTSBU962
00145          NEXT SENTENCE                                            DTSBU962
00146      ELSE                                                         DTSBU962
00147          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00148                                                                   DTSBU962
00149      MOVE +0 TO WRK-REC-CNT.                                      DTSBU962
00150  P1100-EXIT.                                                      DTSBU962
00151      EXIT.                                                        DTSBU962
00152      SKIP3                                                        DTSBU962
00153  P1200-CLOSE.                                                     DTSBU962
00154      CLOSE MST-FILE.                                              DTSBU962
00155                                                                   DTSBU962
00156      IF NOT FILE-OK-88                                            DTSBU962
00157          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00158                                                                   DTSBU962
00159      DISPLAY '*** '                                               DTSBU962
00160              WRK-REC-CNT                                          DTSBU962
00161              ' DTSFMSTO RECORDS WRITTEN'.                         DTSBU962
00162  P1200-EXIT.                                                      DTSBU962
00163      EXIT.                                                        DTSBU962
00164      EJECT                                                        DTSBU962
00165  P2300-WRITE.                                                     DTSBU962
00166      PERFORM S1000-LINK-TO-FILE THRU S1000-EXIT.                  DTSBU962
00167                                                                   DTSBU962
00168      MOVE WRK-REC-LENGTH TO MST-REC-LEN.                          DTSBU962
00169                                                                   DTSBU962
00170      WRITE FILE-REC.                                              DTSBU962
00171                                                                   DTSBU962
00172      IF NOT FILE-OK-88                                            DTSBU962
00173          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00174                                                                   DTSBU962
00175      ADD +1 TO WRK-REC-CNT.                                       DTSBU962
00176  P2300-EXIT.                                                      DTSBU962
00177      EXIT.                                                        DTSBU962
00178      EJECT                                                        DTSBU962
00179  S1000-LINK-TO-FILE.                                              DTSBU962
00180      MOVE MLEN-MSKL-NONDATA-LEN TO WRK-REC-LENGTH.                DTSBU962
00181                                                                   DTSBU962
00182      IF (MSKL-REC-TYPE OF LINK-REC < +1)                          DTSBU962
00183              OR                                                   DTSBU962
00184         (MSKL-REC-TYPE OF LINK-REC > MLEN-MAX-REC-TYPE)           DTSBU962
00185          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00186                                                                   DTSBU962
00187      SET MLEN-IDX TO MSKL-REC-TYPE OF LINK-REC.                   DTSBU962
00188                                                                   DTSBU962
00189      IF MLEN-FILE-ID (MLEN-IDX) = +0                              DTSBU962
00190          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00191                                                                   DTSBU962
00192      MOVE MLEN-FIX-LEN (MLEN-IDX) TO WRK-DATA-LENGTH.             DTSBU962
00193                                                                   DTSBU962
00194      IF MLEN-OCC-MAX (MLEN-IDX) = +0                              DTSBU962
00195          ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH                    DTSBU962
00196          PERFORM S1100-KEY-FILLER THRU S1100-EXIT                 DTSBU962
00197          MOVE LINK-REC (1:WRK-REC-LENGTH)                         DTSBU962
00198            TO FILE-REC (1:WRK-REC-LENGTH)                         DTSBU962
00199          GO TO S1000-EXIT.                                        DTSBU962
00200                                                                   DTSBU962
00201      COMPUTE OCC-COUNT-START = WRK-DATA-LENGTH - 1.               DTSBU962
00202                                                                   DTSBU962
00203      MOVE MSKL-DATA-AREA OF LINK-REC (OCC-COUNT-START:2)          DTSBU962
00204        TO OCC-COUNT-X.                                            DTSBU962
00205                                                                   DTSBU962
00206      IF (OCC-COUNT < +0)                                          DTSBU962
00207            OR                                                     DTSBU962
00208         (OCC-COUNT > MLEN-OCC-MAX (MLEN-IDX))                     DTSBU962
00209          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00210                                                                   DTSBU962
00211      COMPUTE WRK-DATA-LENGTH = WRK-DATA-LENGTH                    DTSBU962
00212        + (OCC-COUNT * MLEN-VAR-LEN (MLEN-IDX)).                   DTSBU962
00213                                                                   DTSBU962
00214      IF WRK-DATA-LENGTH > MLEN-MAX-MSKL-DATA-LEN                  DTSBU962
00215          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBU962
00216                                                                   DTSBU962
00217      ADD WRK-DATA-LENGTH TO WRK-REC-LENGTH.                       DTSBU962
00218                                                                   DTSBU962
00219      PERFORM S1100-KEY-FILLER THRU S1100-EXIT.                    DTSBU962
00220                                                                   DTSBU962
00221                                                                   DTSBU962
00222      MOVE LINK-REC (1:WRK-REC-LENGTH)                             DTSBU962
00223        TO FILE-REC (1:WRK-REC-LENGTH).                            DTSBU962
00224  S1000-EXIT.                                                      DTSBU962
00225      EXIT.                                                        DTSBU962
00226      SKIP3                                                        DTSBU962
00227  S1100-KEY-FILLER.                                                DTSBU962
00228      COMPUTE WRK-KEY-FILLER-START                                 DTSBU962
00229        = MLEN-KEY-LEN (MLEN-IDX) + 1.                             DTSBU962
00230                                                                   DTSBU962
00231      COMPUTE WRK-KEY-FILLER-LENGTH                                DTSBU962
00232        = MLEN-MAX-KEY-LEN - MLEN-KEY-LEN (MLEN-IDX).              DTSBU962
00233                                                                   DTSBU962
00234      IF WRK-KEY-FILLER-LENGTH > +0                                DTSBU962
00235          MOVE LOW-VALUES                                          DTSBU962
00236            TO MSKL-KEY-AREA OF LINK-REC                           DTSBU962
00237                 (WRK-KEY-FILLER-START:WRK-KEY-FILLER-LENGTH).     DTSBU962
00238  S1100-EXIT.                                                      DTSBU962
00239      EXIT.                                                        DTSBU962
00240      EJECT                                                        DTSBU962
00241  S9100-PRE-DISPLAY.                                               DTSBU962
00242      DISPLAY ' '.                                                 DTSBU962
00243      DISPLAY ' '.                                                 DTSBU962
00244      DISPLAY '*** DTSBU962 PRE  TRACE DISPLAY ***'.               DTSBU962
00245      DISPLAY L962-MOD-NAME                                        DTSBU962
00246              ' = L962-MOD-NAME'.                                  DTSBU962
00247      DISPLAY L962-CMND-CD                                         DTSBU962
00248              ' = L962-CMND-CD'.                                   DTSBU962
00249                                                                   DTSBU962
00250      PERFORM S9300-REC-DISPLAY THRU S9300-EXIT.                   DTSBU962
00251  S9100-EXIT.                                                      DTSBU962
00252      EXIT.                                                        DTSBU962
00253      SKIP3                                                        DTSBU962
00254  S9200-POST-DISPLAY.                                              DTSBU962
00255      DISPLAY ' '.                                                 DTSBU962
00256      DISPLAY '*** DTSBU962 POST TRACE DISPLAY ***'.               DTSBU962
00257      DISPLAY L962-RESULT-IND                                      DTSBU962
00258              ' = L962-RESULT-IND'.                                DTSBU962
00259  S9200-EXIT.                                                      DTSBU962
00260      EXIT.                                                        DTSBU962
00261      SKIP3                                                        DTSBU962
00262  S9300-REC-DISPLAY.                                               DTSBU962
00263      DISPLAY ' '.                                                 DTSBU962
00264                                                                   DTSBU962
00265      IF (MSKL-REC-TYPE OF LINK-REC < +1)                          DTSBU962
00266              OR                                                   DTSBU962
00267         (MSKL-REC-TYPE OF LINK-REC > MLEN-MAX-REC-TYPE)           DTSBU962
00268          MOVE SPACES TO WRK-REC-PREFIX                            DTSBU962
00269      ELSE                                                         DTSBU962
00270          MOVE MLEN-PREFIX (MSKL-REC-TYPE OF LINK-REC)             DTSBU962
00271            TO WRK-REC-PREFIX.                                     DTSBU962
00272                                                                   DTSBU962
00273      IF WRK-REC-PREFIX = SPACES                                   DTSBU962
00274          MOVE '????' TO WRK-REC-PREFIX.                           DTSBU962
00275                                                                   DTSBU962
00276      MOVE MLEN-MAX-KEY-LEN TO L991-REQ-CHAR-CNT.                  DTSBU962
00277                                                                   DTSBU962
00278      MOVE MSKL-KEY-AREA OF LINK-REC TO L991-REQ-AREA.             DTSBU962
00279                                                                   DTSBU962
00280      PERFORM S991-HEX-FORMAT THRU S991-EXIT.                      DTSBU962
00281                                                                   DTSBU962
00282      DISPLAY 'REC TYPE = '                                        DTSBU962
00283              WRK-REC-PREFIX.                                      DTSBU962
00284      DISPLAY 'KEY AREA = '                                        DTSBU962
00285              L991-REPLY-HEX-1-AREA.                               DTSBU962
00286      DISPLAY '           '                                        DTSBU962
00287              L991-REPLY-HEX-2-AREA.                               DTSBU962
00288      DISPLAY '           '                                        DTSBU962
00289              L991-REPLY-AN-AREA.                                  DTSBU962
00290  S9300-EXIT.                                                      DTSBU962
00291      EXIT.                                                        DTSBU962
00292      EJECT                                                        DTSBU962
00293  S991-HEX-FORMAT.                                                 DTSBU962
00294      CALL 'DTSBU991' USING L991-LINK-AREA.                        DTSBU962
00295  S991-EXIT.                                                       DTSBU962
00296      EXIT.                                                        DTSBU962
00297      SKIP3                                                        DTSBU962
00298  S999-ABEND.                                                      DTSBU962
00299      DISPLAY '*** MASTER FILE SEQUENTIAL INPUT MODULE ABENDING'.  DTSBU962
00300      DISPLAY '*** CMND-CD = ' L962-CMND-CD.                       DTSBU962
00301      DISPLAY '*** FILE-STATUS = ' FILE-STATUS.                    DTSBU962
00302      DISPLAY '*** CALLING MODULE = ' L962-MOD-NAME.               DTSBU962
00303                                                                   DTSBU962
00304      PERFORM S9300-REC-DISPLAY THRU S9300-EXIT.                   DTSBU962
00305                                                                   DTSBU962
00306      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBU962
00307  S999-EXIT.                                                       DTSBU962
00308      EXIT.                                                        DTSBU962
