00001  IDENTIFICATION DIVISION.                                         03/21/03
00002  PROGRAM-ID.             DESBD100.                                DESBD100
00003  AUTHOR.                 TRW.                                        LV005
00004  DATE-WRITTEN.           MARCH 2001.                              DESBD100
00005  DATE-COMPILED.                                                   DESBD100
00006      SKIP3                                                        DESBD100
00007 *****                                                             DESBD100
00008 *                                                                 DESBD100
00009 *    FUNCTION:  BUILD DAILY PRINT REPORT RECORDS FOR              DESBD100
00010 *               ELECTRONIC MEDIA TRACKING SYSTEM                  DESBD100
00011 *                                                                 DESBD100
00012 *    MODIFIED ON 03/29/02   GB                                    DESBD100
00013 *    ADDED EPRF-FORMAT-CD, EPRF-DATA-TYPE-CD, EPRF-MEDIUM-TYPE.   DESBD100
00014 *    TO PACKING LIST REPORT.                                      DESBD100
00015 *                                                                 DESBD100
00016 *****                                                             DESBD100
00017      SKIP3                                                        DESBD100
00018  ENVIRONMENT DIVISION.                                            DESBD100
00019 *INPUT-OUTPUT SECTION.                                            DESBD100
00020 *FILE-CONTROL.                                                    DESBD100
00021 *    SELECT BD100-PARM-FILE ASSIGN TO DESBD100                    DESBD100
00022 *           FILE STATUS IS BD100-PARM-STATUS.                     DESBD100
00023      SKIP2                                                        DESBD100
00024  DATA DIVISION.                                                   DESBD100
00025 *FILE SECTION.                                                    DESBD100
00026 *FD  BD100-PARM-FILE                                              DESBD100
00027 *    RECORDING MODE IS F                                          DESBD100
00028 *    BLOCK CONTAINS 0 RECORDS.                                    DESBD100
00029 *                                                                 DESBD100
00030 *01  BD100-PARM-REC.                                              DESBD100
00031 *    05  BD100-PARM-LAST-ABSTIME      PIC  9(15).                 DESBD100
00032 *    05  FILLER                       PIC  X(65).                 DESBD100
00033                                                                   DESBD100
00034  WORKING-STORAGE SECTION.                                         DESBD100
000345 77  PAN-VALET PICTURE X(24) VALUE '005DESBD100  03/21/03'.       DESBD100
00035      SKIP3                                                        DESBD100
00036  01  WRK-AREA.                                                    DESBD100
00037      05  WRK-ABEND-CD            PIC S9(04)  COMP  VALUE +100.    DESBD100
00038                                                                   DESBD100
00039      05  WRK-MOD-NAME            PIC  X(08)  VALUE 'DESBD100'.    DESBD100
00040                                                                   DESBD100
00041      05  ERR-SUB                 PIC S9(04)  COMP.                DESBD100
00042                                                                   DESBD100
00043      05  WRK-LOG-NO              PIC  9(10)         VALUE 0.      DESBD100
00044                                                                   DESBD100
00045      05  WRK-TRG-CNT             PIC  9(05)  COMP-3 VALUE 0.      DESBD100
00046      05  WRK-TRG-SELECTED-CNT    PIC  9(05)  COMP-3 VALUE 0.      DESBD100
00047      05  WRK-101-CNT             PIC  9(05)  COMP-3 VALUE 0.      DESBD100
00048      05  WRK-102-CNT             PIC  9(05)  COMP-3 VALUE 0.      DESBD100
00049      05  WRK-CNT-DISP            PIC  Z(04)9.                     DESBD100
00050                                                                   DESBD100
00051      05  BD100-PARM-STATUS              PIC  X(02).               DESBD100
00052          88 BD100-PARM-FILE-OK-88    VALUE '00'.                  DESBD100
00053                                                                   DESBD100
00054      05  WRK-LAST-ABSTIME        PIC S9(15) COMP-3  VALUE +0.     DESBD100
00055      05  WRK-NEW-ABSTIME         PIC S9(15) COMP-3  VALUE +0.     DESBD100
00056                                                                   DESBD100
00057      05  WRK-ERROR-IND               PIC  X(01).                  DESBD100
00058          88 WRK-ERROR-YES-88      VALUE 'Y'.                      DESBD100
00059          88 WRK-ERROR-NO-88       VALUE 'N'.                      DESBD100
00060                                                                   DESBD100
00061      05  WRK-TRACE-IND        PIC  X(01)   VALUE ' '.             DESBD100
00062                                                                   DESBD100
00063  01  L041-LINK-AREA.                                              DESBD100
00064  ++INCLUDE DTSIL041                                               DESBD100
00065      EJECT                                                        DESBD100
00066  01  L111-LINK-AREA.                                              DESBD100
00067  ++INCLUDE DTSIL111                                               DESBD100
00068      EJECT                                                        DESBD100
00069  01  L112-LINK-AREA.                                              DESBD100
00070  ++INCLUDE DTSIL112                                               DESBD100
00071      EJECT                                                        DESBD100
00072  01  C200-CONSTANTS.                                              DESBD100
00073  ++INCLUDE DTSIC200                                               DESBD100
00074      EJECT                                                        DESBD100
00075  01  T060-REC.                                                    DESBD100
00076  ++INCLUDE DTSIT060                                               DESBD100
00077      EJECT                                                        DESBD100
00078  01  R101-REC.                                                    DESBD100
00079  ++INCLUDE DESIR101                                               DESBD100
00080      EJECT                                                        DESBD100
00081  01  R102-REC.                                                    DESBD100
00082  ++INCLUDE DESIR102                                               DESBD100
00083      EJECT                                                        DESBD100
00084  01  L921-LINK-AREA.                                              DESBD100
00085  ++INCLUDE DTSIL921                                               DESBD100
00086      EJECT                                                        DESBD100
00087  01  ISKL-REC.                                                    DESBD100
00088  ++INCLUDE DTSIISKL                                               DESBD100
00089      EJECT                                                        DESBD100
00090  01  IENM-REC.                                                    DESBD100
00091  ++INCLUDE DTSIIENM                                               DESBD100
00092      EJECT                                                        DESBD100
00093  01  IEAL-REC.                                                    DESBD100
00094  ++INCLUDE DTSIIEAL                                               DESBD100
00095      EJECT                                                        DESBD100
00096  01  IEAE-REC.                                                    DESBD100
00097  ++INCLUDE DTSIIEAE                                               DESBD100
00098      EJECT                                                        DESBD100
00099  01  IEBX-REC.                                                    DESBD100
00100  ++INCLUDE DTSIIEBX                                               DESBD100
00101      EJECT                                                        DESBD100
00102  01  IEOP-REC.                                                    DESBD100
00103  ++INCLUDE DTSIIEOP                                               DESBD100
00104      EJECT                                                        DESBD100
00105  01  IESR-REC.                                                    DESBD100
00106  ++INCLUDE DTSIIESR                                               DESBD100
00107      EJECT                                                        DESBD100
00108  01  IEER-REC.                                                    DESBD100
00109  ++INCLUDE DTSIIEER                                               DESBD100
00110      EJECT                                                        DESBD100
00111  01  IEET-REC.                                                    DESBD100
00112  ++INCLUDE DTSIIEET                                               DESBD100
00113      EJECT                                                        DESBD100
00114  01  IEPR-REC.                                                    DESBD100
00115  ++INCLUDE DTSIIEPR                                               DESBD100
00116      EJECT                                                        DESBD100
00117  01  L924-LINK-AREA.                                              DESBD100
00118  ++INCLUDE DTSIL924                                               DESBD100
00119      EJECT                                                        DESBD100
00120  01  RSK3-REC.                                                    DESBD100
00121  ++INCLUDE DTSIRSK3                                               DESBD100
00122                                                                   DESBD100
00123  01  TRIG-REC REDEFINES RSK3-REC.                                 DESBD100
00124      05  TRIG-REC-LENGTH        PIC S9(04) COMP.                  DESBD100
00125      05  TRIG-REC-TYPE          PIC  X(03).                       DESBD100
00126          88  TRIG-REC-TYPE-EMEDIA-88 VALUE '060' '061'.           DESBD100
00127      05  FILLER                 PIC  X(4084).                     DESBD100
00128      EJECT                                                        DESBD100
00129  01  L935-LINK-AREA.                                              DESBD100
00130  ++INCLUDE DTSIL935                                               DESBD100
00131      EJECT                                                        DESBD100
00132  01  ESKL-REC.                                                    DESBD100
00133  ++INCLUDE DTSIESKL                                               DESBD100
00134      EJECT                                                        DESBD100
00135  01  EPRF-REC.                                                    DESBD100
00136  ++INCLUDE DTSIEPRF                                               DESBD100
00137                                                                   DESBD100
00138  01  ELOG-REC.                                                    DESBD100
00139  ++INCLUDE DTSIELOG                                               DESBD100
00140                                                                   DESBD100
00141  01  EMSG-REC.                                                    DESBD100
00142  ++INCLUDE DTSIEMSG                                               DESBD100
00143      EJECT                                                        DESBD100
00144                                                                   DESBD100
00145  PROCEDURE DIVISION.                                              DESBD100
00146                                                                   DESBD100
00147  DESBD100-MAIN.                                                   DESBD100
00148      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DESBD100
00149      IF WRK-ERROR-YES-88                                          DESBD100
00150         GO TO DESBD100-MAIN-EXIT.                                 DESBD100
00151                                                                   DESBD100
00152      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DESBD100
00153                                                                   DESBD100
00154      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DESBD100
00155                                                                   DESBD100
00156  DESBD100-MAIN-EXIT.                                              DESBD100
00157      GOBACK.                                                      DESBD100
00158      EJECT                                                        DESBD100
00159  I0000-INITIATE.                                                  DESBD100
00160      SET WRK-ERROR-NO-88 TO TRUE.                                 DESBD100
00161                                                                   DESBD100
00162      MOVE LENGTH OF R101-REC TO R101-LENGTH.                      DESBD100
00163      MOVE '101' TO R101-REC-TYPE.                                 DESBD100
00164                                                                   DESBD100
00165      MOVE LENGTH OF R102-REC TO R102-LENGTH.                      DESBD100
00166      MOVE '102' TO R102-REC-TYPE.                                 DESBD100
00167                                                                   DESBD100
00168      PERFORM I1000-OPEN-FILES           THRU I1000-EXIT.          DESBD100
00169                                                                   DESBD100
00170 ***  PERFORM I2000-GET-LAST-PRINT-TIME  THRU I2000-EXIT.          DESBD100
00171                                                                   DESBD100
00172  I0000-EXIT.                                                      DESBD100
00173      EXIT.                                                        DESBD100
00174                                                                   DESBD100
00175  I1000-OPEN-FILES.                                                DESBD100
00176      MOVE WRK-TRACE-IND  TO L935-TRACE-IND                        DESBD100
00177                             L921-TRACE-IND                        DESBD100
00178                             L924-TRACE-IND.                       DESBD100
00179                                                                   DESBD100
00180      MOVE WRK-MOD-NAME TO L921-MOD-NAME                           DESBD100
00181                           L924-MOD-NAME                           DESBD100
00182                           L935-MOD-NAME.                          DESBD100
00183                                                                   DESBD100
00184      PERFORM S921-OPEN-READ   THRU S921-EXIT.                     DESBD100
00185      PERFORM S935-OPEN-READ   THRU S935-EXIT.                     DESBD100
00186                                                                   DESBD100
00187      SET L924-OPEN-READ-88 TO TRUE.                               DESBD100
00188                                                                   DESBD100
00189      PERFORM S924-OLA-I THRU S924-EXIT.                           DESBD100
00190                                                                   DESBD100
00191  I1000-EXIT.                                                      DESBD100
00192      EXIT.                                                        DESBD100
00193                                                                   DESBD100
00194 *I2000-GET-LAST-PRINT-TIME.                                       DESBD100
00195 *    OPEN INPUT BD100-PARM-FILE.                                  DESBD100
00196 *    IF NOT BD100-PARM-FILE-OK-88                                 DESBD100
00197 *       DISPLAY 'PARM FILE OPEN ERROR: ' BD100-PARM-STATUS        DESBD100
00198 *       SET WRK-ERROR-YES-88 TO TRUE                              DESBD100
00199 *       GO TO I2000-EXIT.                                         DESBD100
00200 *                                                                 DESBD100
00201 *    READ BD100-PARM-FILE.                                        DESBD100
00202 *    IF NOT BD100-PARM-FILE-OK-88                                 DESBD100
00203 *       DISPLAY 'PARM FILE READ ERROR: ' BD100-PARM-STATUS        DESBD100
00204 *       SET WRK-ERROR-YES-88 TO TRUE                              DESBD100
00205 *       GO TO I2000-EXIT.                                         DESBD100
00206 *                                                                 DESBD100
00207 *    IF BD100-PARM-LAST-ABSTIME NUMERIC                           DESBD100
00208 *       MOVE BD100-PARM-LAST-ABSTIME    TO WRK-LAST-ABSTIME       DESBD100
00209 *    ELSE                                                         DESBD100
00210 *       DISPLAY 'INVALID PARM ABSTIME '                           DESBD100
00211 *       SET WRK-ERROR-YES-88 TO TRUE                              DESBD100
00212 *       GO TO I2000-EXIT.                                         DESBD100
00213 *                                                                 DESBD100
00214 *    CLOSE BD100-PARM-FILE.                                       DESBD100
00215 *                                                                 DESBD100
00216 *    DISPLAY 'LAST UPDATE TIME ' WRK-LAST-ABSTIME.                DESBD100
00217 *                                                                 DESBD100
00218 *I2000-EXIT.                                                      DESBD100
00219 *    EXIT.                                                        DESBD100
00220      EJECT                                                        DESBD100
00221  P0000-PROCESS.                                                   DESBD100
00222                                                                   DESBD100
00223      SET L924-READ-NEXT-88 TO TRUE.                               DESBD100
00224                                                                   DESBD100
00225      PERFORM S924-OLA-I THRU S924-EXIT.                           DESBD100
00226                                                                   DESBD100
00227      IF L924-OK-88                                                DESBD100
00228         PERFORM P1000-SCAN-OLA THRU P1000-EXIT                    DESBD100
00229            UNTIL L924-NO-REC-88                                   DESBD100
00230      ELSE                                                         DESBD100
00231         DISPLAY 'NO TRIGGER REC'                                  DESBD100
00232         GO TO P0000-EXIT                                          DESBD100
00233      END-IF.                                                      DESBD100
00234                                                                   DESBD100
00235  P0000-EXIT.                                                      DESBD100
00236      EXIT.                                                        DESBD100
00237      EJECT                                                        DESBD100
00238                                                                   DESBD100
00239  P1000-SCAN-OLA.                                                  DESBD100
00240      ADD +1                         TO WRK-TRG-CNT.               DESBD100
00241                                                                   DESBD100
00242                                                                   DESBD100
00243      IF RSK3-REC-TYPE = '060'                                     DESBD100
00244         MOVE RSK3-REC                TO T060-REC                  DESBD100
00245 *&      IF T060-ABSTIME > WRK-LAST-ABSTIME                        DESBD100
00246 *          IF T060-ABSTIME > WRK-NEW-ABSTIME                      DESBD100
00247 *             MOVE T060-ABSTIME TO WRK-NEW-ABSTIME                DESBD100
00248 *&         END-IF                                                 DESBD100
00249            ADD +1                    TO WRK-TRG-SELECTED-CNT      DESBD100
00250            PERFORM P2000-BUILD-RPT-RECS THRU P2000-EXIT.          DESBD100
00251                                                                   DESBD100
00252      PERFORM S924-OLA-I THRU S924-EXIT.                           DESBD100
00253                                                                   DESBD100
00254  P1000-EXIT.                                                      DESBD100
00255      EXIT.                                                        DESBD100
00256                                                                   DESBD100
00257  P2000-BUILD-RPT-RECS.                                            DESBD100
00258      MOVE T060-LOG-NO             TO WRK-LOG-NO.                  DESBD100
00259      SET WRK-ERROR-NO-88 TO TRUE                                  DESBD100
00260      PERFORM S1000-READ-LOG-PRF   THRU S1000-EXIT                 DESBD100
00261      IF WRK-ERROR-YES-88                                          DESBD100
00262         GO TO P2000-EXIT                                          DESBD100
00263      END-IF.                                                      DESBD100
00264                                                                   DESBD100
00265      IF T060-TYPE-PCK-LST-88                                      DESBD100
00266         PERFORM P2100-BUILD-R101    THRU P2100-EXIT               DESBD100
00267      ELSE                                                         DESBD100
00268      IF T060-TYPE-NOTICE-88                                       DESBD100
00269         PERFORM P2200-BUILD-R102    THRU P2200-EXIT.              DESBD100
00270                                                                   DESBD100
00271  P2000-EXIT.                                                      DESBD100
00272      EXIT.                                                        DESBD100
00273                                                                   DESBD100
00274  P2100-BUILD-R101.                                                DESBD100
00275      ADD +1               TO WRK-101-CNT.                         DESBD100
00276                                                                   DESBD100
00277      PERFORM P2110-FIND-JOB  THRU P2110-EXIT.                     DESBD100
00278                                                                   DESBD100
00279      MOVE ELOG-BOX-NO        TO R101-BOX-NO.                      DESBD100
00280      MOVE ELOG-LOG-NO        TO R101-LOG-NO.                      DESBD100
00281      MOVE EPRF-ELF-ID        TO R101-ELF-ID.                      DESBD100
00282      MOVE EPRF-ELF-NAME      TO R101-ELF-NAME.                    DESBD100
00283      MOVE EPRF-FORMAT-CD     TO R101-FORMAT-CD.                   DESBD100
00284      MOVE EPRF-DATA-TYPE-CD  TO R101-DATA-TYPE-CD.                DESBD100
00285      MOVE EPRF-MEDIUM-TYPE-CD   TO R101-MEDIUM-TYPE-CD.           DESBD100
00286      MOVE ELOG-CHNG-OPID     TO R101-OPID.                        DESBD100
00287                                                                   DESBD100
00288      PERFORM S946-WRITE-R101 THRU S946-EXIT.                      DESBD100
00289                                                                   DESBD100
00290  P2100-EXIT.                                                      DESBD100
00291      EXIT.                                                        DESBD100
00292                                                                   DESBD100
00293  P2110-FIND-JOB.                                                  DESBD100
00294      IF EPRF-JOB-NAME NOT = SPACES                                DESBD100
00295         MOVE EPRF-JOB-NAME     TO R101-JOBNAME                    DESBD100
00296      ELSE                                                         DESBD100
00297         PERFORM                                                   DESBD100
00298            VARYING C200-JOB-IDX FROM +1 BY +1                     DESBD100
00299            UNTIL C200-JOB-IDX > C200-JOB-TABLE-MAX                DESBD100
00300               IF (C200-FORMAT (C200-JOB-IDX)                      DESBD100
00301                                  = EPRF-FORMAT-CD                 DESBD100
00302               AND C200-MEDIUM (C200-JOB-IDX)                      DESBD100
00303                                  = EPRF-MEDIUM-TYPE-CD)           DESBD100
00304                  MOVE C200-JOB (C200-JOB-IDX)                     DESBD100
00305                                  TO R101-JOBNAME                  DESBD100
00306               END-IF                                              DESBD100
00307         END-PERFORM                                               DESBD100
00308      END-IF.                                                      DESBD100
00309                                                                   DESBD100
00310  P2110-EXIT.                                                      DESBD100
00311      EXIT.                                                        DESBD100
00312                                                                   DESBD100
00313  P2200-BUILD-R102.                                                DESBD100
00314      ADD +1                       TO WRK-102-CNT.                 DESBD100
00315                                                                   DESBD100
00316      MOVE ELOG-BOX-NO             TO R102-BOX-NO.                 DESBD100
00317      MOVE ELOG-LOG-NO             TO R102-LOG-NO.                 DESBD100
00318      MOVE EPRF-ELF-ID             TO R102-ELF-ID.                 DESBD100
00319      MOVE EPRF-FORMAT-CD          TO R102-FORMAT-CD.              DESBD100
00320                                                                   DESBD100
00321      SET L112-FID-MAILING-ADDR-88 TO TRUE.                        DESBD100
00322      SET L112-ANCHOR-FIRST-88     TO TRUE.                        DESBD100
00323      MOVE EPRF-ELF-NAME           TO L112-NAME.                   DESBD100
00324      MOVE EPRF-ADDRESS            TO L112-ADDRESS.                DESBD100
00325      PERFORM S112-ADDR-FORMAT     THRU S112-EXIT.                 DESBD100
00326      MOVE L112-MAILING-ADDRESS    TO R102-FMT-ADDR.               DESBD100
00327      MOVE L112-ZIP                TO R102-ZIP.                    DESBD100
00328      MOVE L112-ADVANCED-BARCODE   TO R102-ADVANCED-BARCODE.       DESBD100
00329                                                                   DESBD100
00330      MOVE ELOG-CHNG-OPID     TO R102-OPID.                        DESBD100
00331      MOVE ZERO                TO R102-MAIL-DATE.                  DESBD100
00332 *&   MOVE LECM-CURR-MAIL-DATE TO R102-MAIL-DATE.                  DESBD100
00333                                                                   DESBD100
00334      MOVE ZERO               TO ERR-SUB.                          DESBD100
00335      PERFORM P2210-ERRORS    THRU P2210-EXIT.                     DESBD100
00336                                                                   DESBD100
00337      IF ERR-SUB = ZERO                                            DESBD100
00338         SET R102-RPT-TYPE-CONFIRM-88 TO TRUE                      DESBD100
00339      ELSE                                                         DESBD100
00340         SET R102-RPT-TYPE-ERROR-88 TO TRUE.                       DESBD100
00341                                                                   DESBD100
00342      PERFORM S946-WRITE-R102 THRU S946-EXIT.                      DESBD100
00343                                                                   DESBD100
00344  P2200-EXIT.                                                      DESBD100
00345      EXIT.                                                        DESBD100
00346                                                                   DESBD100
00347  P2210-ERRORS.                                                    DESBD100
00348      MOVE LOW-VALUES TO EMSG-REC.                                 DESBD100
00349                                                                   DESBD100
00350      SET EMSG-MSG-88         TO TRUE.                             DESBD100
00351      MOVE ELOG-LOG-NO        TO EMSG-LOG-NO                       DESBD100
00352      MOVE ZERO               TO EMSG-ABSTIME                      DESBD100
00353                                 EMSG-SEQ.                         DESBD100
00354      MOVE EMSG-KEY-AREA      TO ESKL-KEY-AREA.                    DESBD100
00355                                                                   DESBD100
00356      PERFORM S935-START-BROWSE THRU S935-EXIT.                    DESBD100
00357      IF L935-OK-88                                                DESBD100
00358         PERFORM P2211-SCAN-MSG THRU P2211-EXIT                    DESBD100
00359            UNTIL L935-NO-REC-88                                   DESBD100
00360      ELSE                                                         DESBD100
00361         DISPLAY 'CANNOT READ MESSAGE'                             DESBD100
00362         GO TO P2210-EXIT                                          DESBD100
00363      END-IF.                                                      DESBD100
00364                                                                   DESBD100
00365  P2210-EXIT.                                                      DESBD100
00366      EXIT.                                                        DESBD100
00367                                                                   DESBD100
00368  P2211-SCAN-MSG.                                                  DESBD100
00369      MOVE ESKL-REC        TO EMSG-REC.                            DESBD100
00370      IF EMSG-TYPE-ERROR-88                                        DESBD100
00371      OR EMSG-TYPE-MANUAL-88                                       DESBD100
00372         IF ERR-SUB < +50                                          DESBD100
00373            ADD +1                  TO ERR-SUB                     DESBD100
00374            MOVE EMSG-FULL-MESSAGE  TO R102-ERROR (ERR-SUB)        DESBD100
00375            MOVE ERR-SUB            TO R102-ERR-CNT.               DESBD100
00376                                                                   DESBD100
00377      PERFORM S935-READ-NEXT    THRU S935-EXIT.                    DESBD100
00378                                                                   DESBD100
00379  P2211-EXIT.                                                      DESBD100
00380      EXIT.                                                        DESBD100
00381                                                                   DESBD100
00382  T0000-TERMINATE.                                                 DESBD100
00383                                                                   DESBD100
00384      DISPLAY ' '.                                                 DESBD100
00385                                                                   DESBD100
00386      DISPLAY '*** DESBD100 TERMINATION STATISTICS ***'.           DESBD100
00387                                                                   DESBD100
00388      DISPLAY ' '.                                                 DESBD100
00389                                                                   DESBD100
00390      MOVE WRK-TRG-CNT   TO WRK-CNT-DISP.                          DESBD100
00391      DISPLAY '    TRIGGER RECORDS READ:     '                     DESBD100
00392         WRK-CNT-DISP.                                             DESBD100
00393                                                                   DESBD100
00394      MOVE WRK-TRG-SELECTED-CNT   TO WRK-CNT-DISP.                 DESBD100
00395      DISPLAY '    TRIGGER RECORDS SELECTED: '                     DESBD100
00396         WRK-CNT-DISP.                                             DESBD100
00397                                                                   DESBD100
00398      MOVE WRK-101-CNT   TO WRK-CNT-DISP.                          DESBD100
00399      DISPLAY '    R101 RECORDS WRITTEN:     '                     DESBD100
00400         WRK-CNT-DISP.                                             DESBD100
00401                                                                   DESBD100
00402      MOVE WRK-102-CNT   TO WRK-CNT-DISP.                          DESBD100
00403      DISPLAY '    R102 RECORDS WRITTEN:     '                     DESBD100
00404         WRK-CNT-DISP.                                             DESBD100
00405                                                                   DESBD100
00406      DISPLAY SPACE.                                               DESBD100
00407                                                                   DESBD100
00408 *&   PERFORM T1000-UPD-LAST-PRINT-TIME  THRU T1000-EXIT.          DESBD100
00409                                                                   DESBD100
00410  T0000-EXIT.                                                      DESBD100
00411      EXIT.                                                        DESBD100
00412                                                                   DESBD100
00413 *T1000-UPD-LAST-PRINT-TIME.                                       DESBD100
00414 *    IF WRK-NEW-ABSTIME > ZERO                                    DESBD100
00415 *       PERFORM T1100-UPDATE-PARM  THRU T1100-EXIT.               DESBD100
00416 *                                                                 DESBD100
00417 *    DISPLAY 'NEW UPDATE TIME ' WRK-NEW-ABSTIME.                  DESBD100
00418 *                                                                 DESBD100
00419 *T1000-EXIT.                                                      DESBD100
00420 *    EXIT.                                                        DESBD100
00421 *                                                                 DESBD100
00422 *T1100-UPDATE-PARM.                                               DESBD100
00423 *    OPEN OUTPUT BD100-PARM-FILE.                                 DESBD100
00424 *    IF NOT BD100-PARM-FILE-OK-88                                 DESBD100
00425 *       DISPLAY 'PARM FILE OPEN ERROR: ' BD100-PARM-STATUS        DESBD100
00426 *       GO TO T1100-EXIT.                                         DESBD100
00427 *                                                                 DESBD100
00428 *    MOVE WRK-NEW-ABSTIME      TO BD100-PARM-LAST-ABSTIME.        DESBD100
00429 *                                                                 DESBD100
00430 *    WRITE BD100-PARM-REC.                                        DESBD100
00431 *    IF NOT BD100-PARM-FILE-OK-88                                 DESBD100
00432 *       DISPLAY 'PARM FILE WRITE ERROR: ' BD100-PARM-STATUS       DESBD100
00433 *       GO TO T1100-EXIT.                                         DESBD100
00434 *                                                                 DESBD100
00435 *    CLOSE BD100-PARM-FILE.                                       DESBD100
00436 *                                                                 DESBD100
00437 *T1100-EXIT.                                                      DESBD100
00438 *    EXIT.                                                        DESBD100
00439 *    EJECT                                                        DESBD100
00440  S112-ADDR-FORMAT.                                                DESBD100
00441      CALL 'DTSBU112' USING L112-LINK-AREA.                        DESBD100
00442                                                                   DESBD100
00443  S112-EXIT.                                                       DESBD100
00444      EXIT.                                                        DESBD100
00445      EJECT                                                        DESBD100
00446  S921-OPEN-READ.                                                  DESBD100
00447      SET L921-OPEN-READ-88          TO TRUE.                      DESBD100
00448      GO TO S921-AIX-IO.                                           DESBD100
00449                                                                   DESBD100
00450  S921-OPEN-UPDATE.                                                DESBD100
00451      SET L921-OPEN-UPDATE-88        TO TRUE.                      DESBD100
00452      GO TO S921-AIX-IO.                                           DESBD100
00453                                                                   DESBD100
00454  S921-START-BROWSE.                                               DESBD100
00455      SET L921-START-BROWSE-88       TO TRUE.                      DESBD100
00456      GO TO S921-AIX-IO.                                           DESBD100
00457                                                                   DESBD100
00458  S921-READ-NEXT.                                                  DESBD100
00459      SET L921-READ-NEXT-88          TO TRUE.                      DESBD100
00460      GO TO S921-AIX-IO.                                           DESBD100
00461                                                                   DESBD100
00462  S921-CLOSE.                                                      DESBD100
00463      SET L921-CLOSE-88     TO TRUE.                               DESBD100
00464      GO TO S921-AIX-IO.                                           DESBD100
00465                                                                   DESBD100
00466  S921-AIX-IO.                                                     DESBD100
00467      CALL 'DTSBU921' USING L921-LINK-AREA                         DESBD100
00468                            ISKL-REC.                              DESBD100
00469  S921-EXIT.                                                       DESBD100
00470      EXIT.                                                        DESBD100
00471                                                                   DESBD100
00472  S924-OLA-I.                                                      DESBD100
00473      CALL 'DTSBU924' USING L924-LINK-AREA                         DESBD100
00474                            RSK3-REC.                              DESBD100
00475                                                                   DESBD100
00476  S924-EXIT.                                                       DESBD100
00477      EXIT.                                                        DESBD100
00478                                                                   DESBD100
00479  S935-OPEN-READ.                                                  DESBD100
00480      SET L935-OPEN-READ-88 TO TRUE.                               DESBD100
00481      GO TO S935-MSTR-IO.                                          DESBD100
00482                                                                   DESBD100
00483  S935-OPEN-UPDATE.                                                DESBD100
00484      SET L935-OPEN-UPDATE-88        TO TRUE.                      DESBD100
00485      GO TO S935-MSTR-IO.                                          DESBD100
00486                                                                   DESBD100
00487  S935-OPEN-UPDATE-NO-AIX.                                         DESBD100
00488      SET L935-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DESBD100
00489      GO TO S935-MSTR-IO.                                          DESBD100
00490                                                                   DESBD100
00491  S935-READ.                                                       DESBD100
00492      SET L935-READ-88 TO TRUE.                                    DESBD100
00493      GO TO S935-MSTR-IO.                                          DESBD100
00494                                                                   DESBD100
00495  S935-START-BROWSE.                                               DESBD100
00496      SET L935-START-BROWSE-88 TO TRUE.                            DESBD100
00497      GO TO S935-MSTR-IO.                                          DESBD100
00498                                                                   DESBD100
00499  S935-READ-NEXT.                                                  DESBD100
00500      SET L935-READ-NEXT-88 TO TRUE.                               DESBD100
00501      GO TO S935-MSTR-IO.                                          DESBD100
00502                                                                   DESBD100
00503  S935-DELETE.                                                     DESBD100
00504      SET L935-DELETE-88 TO TRUE.                                  DESBD100
00505      GO TO S935-MSTR-IO.                                          DESBD100
00506                                                                   DESBD100
00507  S935-WRITE.                                                      DESBD100
00508      SET L935-WRITE-88 TO TRUE.                                   DESBD100
00509      GO TO S935-MSTR-IO.                                          DESBD100
00510                                                                   DESBD100
00511  S935-REWRITE.                                                    DESBD100
00512      SET L935-REWRITE-88 TO TRUE.                                 DESBD100
00513      GO TO S935-MSTR-IO.                                          DESBD100
00514                                                                   DESBD100
00515  S935-CLOSE.                                                      DESBD100
00516      SET L935-CLOSE-88     TO TRUE.                               DESBD100
00517      GO TO S935-MSTR-IO.                                          DESBD100
00518                                                                   DESBD100
00519  S935-MSTR-IO.                                                    DESBD100
00520      CALL 'DTSBU935' USING L935-LINK-AREA                         DESBD100
00521                            ESKL-REC.                              DESBD100
00522  S935-EXIT.                                                       DESBD100
00523      EXIT.                                                        DESBD100
00524                                                                   DESBD100
00525  S946-WRITE-R101.                                                 DESBD100
00526      CALL 'DTSBU946' USING R101-REC.                              DESBD100
00527      GO TO S946-EXIT.                                             DESBD100
00528                                                                   DESBD100
00529  S946-WRITE-R102.                                                 DESBD100
00530      CALL 'DTSBU946' USING R102-REC.                              DESBD100
00531      GO TO S946-EXIT.                                             DESBD100
00532                                                                   DESBD100
00533  S946-EXIT.                                                       DESBD100
00534      EXIT.                                                        DESBD100
00535                                                                   DESBD100
00536  S1000-READ-LOG-PRF.                                              DESBD100
00537      PERFORM S1010-READ-ELOG        THRU S1010-EXIT.              DESBD100
00538      IF WRK-ERROR-YES-88                                          DESBD100
00539         GO TO S1000-EXIT.                                         DESBD100
00540                                                                   DESBD100
00541      PERFORM S1020-READ-EPRF        THRU S1020-EXIT.              DESBD100
00542                                                                   DESBD100
00543  S1000-EXIT.                                                      DESBD100
00544      EXIT.                                                        DESBD100
00545                                                                   DESBD100
00546  S1010-READ-ELOG.                                                 DESBD100
00547      MOVE LOW-VALUES                   TO ELOG-REC.               DESBD100
00548      MOVE WRK-LOG-NO                   TO ELOG-LOG-NO.            DESBD100
00549      SET ELOG-LOG-88                   TO TRUE.                   DESBD100
00550      MOVE ELOG-KEY-AREA                TO ESKL-KEY-AREA.          DESBD100
00551                                                                   DESBD100
00552      PERFORM S935-READ                 THRU S935-EXIT.            DESBD100
00553      IF L935-NO-REC-88                                            DESBD100
00554          DISPLAY 'INVALID READ: ' WRK-LOG-NO                      DESBD100
00555          SET WRK-ERROR-YES-88           TO TRUE                   DESBD100
00556      ELSE                                                         DESBD100
00557          MOVE ESKL-REC                  TO ELOG-REC               DESBD100
00558      END-IF.                                                      DESBD100
00559                                                                   DESBD100
00560  S1010-EXIT.                                                      DESBD100
00561      EXIT.                                                        DESBD100
00562                                                                   DESBD100
00563  S1020-READ-EPRF.                                                 DESBD100
00564      MOVE LOW-VALUES                   TO EPRF-REC.               DESBD100
00565      MOVE ELOG-ELF-ID                  TO EPRF-ELF-ID.            DESBD100
00566      MOVE ELOG-DATA-TYPE-CD            TO EPRF-DATA-TYPE-CD.      DESBD100
00567      SET EPRF-PRF-88                   TO TRUE.                   DESBD100
00568      MOVE EPRF-KEY-AREA                TO ESKL-KEY-AREA.          DESBD100
00569                                                                   DESBD100
00570      PERFORM S935-READ                 THRU S935-EXIT.            DESBD100
00571      IF L935-NO-REC-88                                            DESBD100
00572          DISPLAY 'INVALID READ ELOG-ELF-ID: ' ELOG-ELF-ID         DESBD100
00573             ELOG-DATA-TYPE-CD                                     DESBD100
00574          SET WRK-ERROR-YES-88           TO TRUE                   DESBD100
00575      ELSE                                                         DESBD100
00576          MOVE ESKL-REC                  TO EPRF-REC               DESBD100
00577      END-IF.                                                      DESBD100
00578                                                                   DESBD100
00579  S1020-EXIT.                                                      DESBD100
00580      EXIT.                                                        DESBD100
00581                                                                   DESBD100
00582      SKIP3                                                        DESBD100
00583  S9999-ABEND.                                                     DESBD100
00584      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DESBD100
00585  S9999-EXIT.                                                      DESBD100
00586      EXIT.                                                        DESBD100
