00001  IDENTIFICATION DIVISION.                                         08/28/02
00002  PROGRAM-ID.             DESBD199.                                DESBD199
00003  AUTHOR.                 TRW.                                        LV001
00004  DATE-WRITTEN.           MARCH 2001.                              DESBD199
00005  DATE-COMPILED.                                                   DESBD199
00006      SKIP3                                                        DESBD199
00007 *****                                                             DESBD199
00008 *                                                                 DESBD199
00009 *    FUNCTION:  SAVE TAPE TRACKING OLA RECORDS.                   DESBD199
00010 *               ELECTRONIC MEDIA TRACKING SYSTEM                  DESBD199
00011 *                                                                 DESBD199
00012 *                                                                 DESBD199
00013 *****                                                             DESBD199
00014      SKIP3                                                        DESBD199
00015  ENVIRONMENT DIVISION.                                            DESBD199
00016  DATA DIVISION.                                                   DESBD199
00017                                                                   DESBD199
00018  WORKING-STORAGE SECTION.                                         DESBD199
000185 77  PAN-VALET PICTURE X(24) VALUE '001DESBD199  08/28/02'.       DESBD199
00019      SKIP3                                                        DESBD199
00020  01  WRK-AREA.                                                    DESBD199
00021      05  WRK-ABEND-CD            PIC S9(04)  COMP  VALUE +199.    DESBD199
00022                                                                   DESBD199
00023      05  WRK-MOD-NAME            PIC  X(08)  VALUE 'DESBD199'.    DESBD199
00024                                                                   DESBD199
00025      05  WRK-OLA-IN-CNT          PIC  9(05)  COMP-3 VALUE 0.      DESBD199
00026      05  WRK-OLA-OUT-CNT         PIC  9(05)  COMP-3 VALUE 0.      DESBD199
00027      05  WRK-CNT-DISP            PIC  Z(04)9.                     DESBD199
00028                                                                   DESBD199
00029      05  WRK-ERROR-IND               PIC  X(01).                  DESBD199
00030          88 WRK-ERROR-YES-88      VALUE 'Y'.                      DESBD199
00031          88 WRK-ERROR-NO-88       VALUE 'N'.                      DESBD199
00032                                                                   DESBD199
00033      05  WRK-OLA-FOUND-IND           PIC  X(01).                  DESBD199
00034          88 WRK-OLA-FOUND-YES-88  VALUE 'Y'.                      DESBD199
00035          88 WRK-OLA-FOUND-NO-88   VALUE 'N'.                      DESBD199
00036                                                                   DESBD199
00037      05  WRK-TRACE-IND        PIC  X(01)   VALUE ' '.             DESBD199
00038                                                                   DESBD199
00039  01  RSK3-REC.                                                    DESBD199
00040  ++INCLUDE DTSIRSK3                                               DESBD199
00041      EJECT                                                        DESBD199
00042  01  T061-REC.                                                    DESBD199
00043  ++INCLUDE DTSIT061                                               DESBD199
00044      EJECT                                                        DESBD199
00045  01  L924-LINK-AREA.                                              DESBD199
00046  ++INCLUDE DTSIL924                                               DESBD199
00047      EJECT                                                        DESBD199
00048                                                                   DESBD199
00049  PROCEDURE DIVISION.                                              DESBD199
00050                                                                   DESBD199
00051  DESBD199-MAIN.                                                   DESBD199
00052      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DESBD199
00053      IF WRK-ERROR-YES-88                                          DESBD199
00054         GO TO DESBD199-MAIN-EXIT.                                 DESBD199
00055                                                                   DESBD199
00056      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DESBD199
00057                                                                   DESBD199
00058      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DESBD199
00059                                                                   DESBD199
00060  DESBD199-MAIN-EXIT.                                              DESBD199
00061      GOBACK.                                                      DESBD199
00062      EJECT                                                        DESBD199
00063  I0000-INITIATE.                                                  DESBD199
00064      SET WRK-ERROR-NO-88 TO TRUE.                                 DESBD199
00065      SET WRK-OLA-FOUND-NO-88 TO TRUE.                             DESBD199
00066                                                                   DESBD199
00067      PERFORM I1000-OPEN-FILES           THRU I1000-EXIT.          DESBD199
00068      IF WRK-ERROR-YES-88                                          DESBD199
00069         GO TO I0000-EXIT.                                         DESBD199
00070                                                                   DESBD199
00071  I0000-EXIT.                                                      DESBD199
00072      EXIT.                                                        DESBD199
00073                                                                   DESBD199
00074  I1000-OPEN-FILES.                                                DESBD199
00075      MOVE WRK-TRACE-IND  TO L924-TRACE-IND.                       DESBD199
00076                                                                   DESBD199
00077      MOVE WRK-MOD-NAME TO L924-MOD-NAME.                          DESBD199
00078                                                                   DESBD199
00079      SET L924-OPEN-READ-88 TO TRUE.                               DESBD199
00080                                                                   DESBD199
00081      PERFORM S924-OLA-I THRU S924-EXIT.                           DESBD199
00082                                                                   DESBD199
00083  I1000-EXIT.                                                      DESBD199
00084      EXIT.                                                        DESBD199
00085                                                                   DESBD199
00086      EJECT                                                        DESBD199
00087  P0000-PROCESS.                                                   DESBD199
00088      SET L924-READ-NEXT-88 TO TRUE.                               DESBD199
00089                                                                   DESBD199
00090      PERFORM S924-OLA-I THRU S924-EXIT.                           DESBD199
00091                                                                   DESBD199
00092      IF L924-OK-88                                                DESBD199
00093         SET WRK-OLA-FOUND-YES-88 TO TRUE                          DESBD199
00094         PERFORM P1000-SCAN-OLA THRU P1000-EXIT                    DESBD199
00095            UNTIL L924-NO-REC-88                                   DESBD199
00096      ELSE                                                         DESBD199
00097         DISPLAY 'NO OLA REC'                                      DESBD199
00098      END-IF.                                                      DESBD199
00099                                                                   DESBD199
00100  P0000-EXIT.                                                      DESBD199
00101      EXIT.                                                        DESBD199
00102      EJECT                                                        DESBD199
00103                                                                   DESBD199
00104  P1000-SCAN-OLA.                                                  DESBD199
00105      ADD +1                         TO WRK-OLA-IN-CNT.            DESBD199
00106                                                                   DESBD199
00107      IF RSK3-REC-TYPE = '060' OR '061'                            DESBD199
00108         ADD +1                       TO WRK-OLA-OUT-CNT           DESBD199
00109         PERFORM S947-O               THRU S947-EXIT.              DESBD199
00110                                                                   DESBD199
00111      PERFORM S924-OLA-I THRU S924-EXIT.                           DESBD199
00112                                                                   DESBD199
00113  P1000-EXIT.                                                      DESBD199
00114      EXIT.                                                        DESBD199
00115                                                                   DESBD199
00116  T0000-TERMINATE.                                                 DESBD199
00117                                                                   DESBD199
00118      DISPLAY ' '.                                                 DESBD199
00119                                                                   DESBD199
00120      DISPLAY '*** DESBD199 TERMINATION STATISTICS ***'.           DESBD199
00121                                                                   DESBD199
00122      DISPLAY ' '.                                                 DESBD199
00123                                                                   DESBD199
00124      MOVE WRK-OLA-IN-CNT TO WRK-CNT-DISP.                         DESBD199
00125      DISPLAY '    TRIGGER RECORDS READ:     '                     DESBD199
00126         WRK-CNT-DISP.                                             DESBD199
00127                                                                   DESBD199
00128      MOVE WRK-OLA-OUT-CNT TO WRK-CNT-DISP.                        DESBD199
00129      DISPLAY '    TRIGGER RECORDS SELECTED: '                     DESBD199
00130         WRK-CNT-DISP.                                             DESBD199
00131                                                                   DESBD199
00132      DISPLAY SPACE.                                               DESBD199
00133                                                                   DESBD199
00134  T0000-EXIT.                                                      DESBD199
00135      EXIT.                                                        DESBD199
00136                                                                   DESBD199
00137  S924-OLA-I.                                                      DESBD199
00138      CALL 'DTSBU924' USING L924-LINK-AREA                         DESBD199
00139                            RSK3-REC.                              DESBD199
00140                                                                   DESBD199
00141  S924-EXIT.                                                       DESBD199
00142      EXIT.                                                        DESBD199
00143                                                                   DESBD199
00144  S947-O.                                                          DESBD199
00145      CALL 'DTSBU947' USING RSK3-REC.                              DESBD199
00146                                                                   DESBD199
00147  S947-EXIT.                                                       DESBD199
00148      EXIT.                                                        DESBD199
