00001  IDENTIFICATION DIVISION.                                         08/28/02
00002  PROGRAM-ID.             DESBD220.                                DESBD220
00003 *AUTHOR.                 TRW INC.                                    LV003
00004 *DATE-WRITTEN.           MARCH 2001.                              DESBD220
00005  DATE-COMPILED.                                                   DESBD220
00006                                                                   DESBD220
00007 *****                                                             DESBD220
00008 *                                                                 DESBD220
00009 *    FUNCTION:                                                    DESBD220
00010 *                                                                 DESBD220
00011 *        ELECTRONIC MEDIA SYSTEM BATCH UPDATE.                    DESBD220
00012 *        DESBD220 READS THE RECORDS THAT DESBD200 WRITES TO       DESBD220
00013 *        A FLAT FILE DURING THE DAY, AND UPDATES THE VSAM         DESBD220
00014 *        FILES.                                                   DESBD220
00015 *                                                                 DESBD220
00016 *        INPUT:                                                   DESBD220
00017 *                                                                 DESBD220
00018 *            DTSIRSK4 - MASTER FILE RECORDS PASSED FROM           DESBD220
00019 *                       FLAT FILE CREATED BY DESBD200.            DESBD220
00020 *                                                                 DESBD220
00021 *       INPUT-OUTPUT:                                             DESBD220
00022 *                                                                 DESBD220
00023 *            DTSIEEMH - VSAM HISTORY FILE.                        DESBD220
00024 *            DTSIEMSG - VSAM STATUS AND ERROR MESSAGE FILE.       DESBD220
00025 *                                                                 DESBD220
00026 *****                                                             DESBD220
00027                                                                   DESBD220
00028 ******************************************************************DESBD220
00029 * MODIFICATION HISTORY:                                          *DESBD220
00030 *                                                                *DESBD220
00031 * 12-01-2000 INITIAL DEVELOPMENT                                 *DESBD220
00032 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW  *DESBD220
00033 *                                                                *DESBD220
00034 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD220
00035 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD220
00036 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *DESBD220
00037 ******************************************************************DESBD220
00038                                                                   DESBD220
00039  ENVIRONMENT DIVISION.                                            DESBD220
00040                                                                   DESBD220
00041  DATA DIVISION.                                                   DESBD220
00042                                                                   DESBD220
00043  WORKING-STORAGE SECTION.                                         DESBD220
000435 77  PAN-VALET PICTURE X(24) VALUE '003DESBD220  08/28/02'.       DESBD220
00044                                                                   DESBD220
00045  01  WRK-AREA.                                                    DESBD220
00046      05  WRK-ABEND-CD            PIC S9(04)  COMP  VALUE +220.    DESBD220
00047      05  WRK-ABEND-MSG           PIC  X(60)  VALUE SPACES.        DESBD220
00048                                                                   DESBD220
00049      05  WRK-MOD-NAME            PIC  X(08)  VALUE 'DESBD220'.    DESBD220
00050                                                                   DESBD220
00051      05  WRK-ELOG-REC-UPDATE     PIC S9(07)  COMP-3 VALUE +0.     DESBD220
00052      05  WRK-EEMH-REC-DELETE     PIC S9(07)  COMP-3 VALUE +0.     DESBD220
00053      05  WRK-EMSG-REC-DELETE     PIC S9(07)  COMP-3 VALUE +0.     DESBD220
00054      05  WRK-EMSG-REC-WRITTEN    PIC S9(07)  COMP-3 VALUE +0.     DESBD220
00055                                                                   DESBD220
00056                                                                   DESBD220
00057  01  WRK-VARIABLES.                                               DESBD220
00058      05  WRK-TRACE-IND           PIC  X(01) VALUE SPACE.          DESBD220
00059                                                                   DESBD220
00060      05  WRK-FATAL-ERROR-IND     PIC  X(01) VALUE ' '.            DESBD220
00061          88  WRK-FATAL-ERROR-YES  VALUE 'Y'.                      DESBD220
00062          88  WRK-FATAL-ERROR-NO   VALUE 'N'.                      DESBD220
00063                                                                   DESBD220
00064      05  WRK-LOG-NO              PIC  9(10)        VALUE  0.      DESBD220
00065                                                                   DESBD220
00066      05  ERR-SUB                 PIC S9(04) COMP   VALUE +0.      DESBD220
00067      05  WRK-CURR-DATE           PIC S9(09) COMP-3 VALUE +0.      DESBD220
00068      05  WRK-DISP-DATE           PIC  X(08).                      DESBD220
00069      05  WRK-CURR-TIME           PIC S9(07) COMP-3 VALUE +0.      DESBD220
00070      05  WRK-DISP-TIME           PIC  X(08).                      DESBD220
00071      05  WRK-ABSTIME             PIC S9(15) COMP-3 VALUE +0.      DESBD220
00072      05  WRK-ABSTIME-XOR         PIC S9(15) COMP-3 VALUE +0.      DESBD220
00073                                                                   DESBD220
00074      05  WRK-EMSG-SEQ            PIC  9(05) COMP-3 VALUE  0.      DESBD220
00075      05  WRK-EEMH-SEQ            PIC  9(04) COMP-3 VALUE  0.      DESBD220
00076      05  WRK-TOT-CNT             PIC S9(05) COMP-3 VALUE +0.      DESBD220
00077      05  WRK-EMP-CNT             PIC S9(07) COMP-3 VALUE +0.      DESBD220
00078      05  WRK-LAST-EMP-NO         PIC S9(07) COMP-3 VALUE +0.      DESBD220
00079      05  WRK-SUCCESS-CNT         PIC S9(07) COMP-3 VALUE +0.      DESBD220
00080                                                                   DESBD220
00081      05  WRK-ERR-MESSAGE         PIC  X(60) VALUE SPACES.         DESBD220
00082                                                                   DESBD220
00083      05  WRK-NO-INPUT-MSG        PIC  X(60) VALUE                 DESBD220
00084          'NO ITEMS WERE RELEASED FOR PROCESSING TODAY'.           DESBD220
00085                                                                   DESBD220
00086      05  WRK-RESULT-CD           PIC  X(02) VALUE ZERO.           DESBD220
00087                                                                   DESBD220
00088      05  WRK-DATE-TYPE           PIC  X(03) VALUE SPACES.         DESBD220
00089      05  WRK-RPT-DATE            PIC  9(08) VALUE 0.              DESBD220
00090      05  WRK-RPT-DATE-IN         PIC  9(08) VALUE 0.              DESBD220
00091      05  FILLER REDEFINES WRK-RPT-DATE-IN.                        DESBD220
00092          10  FILLER              PIC  9(03).                      DESBD220
00093          10  WRK-RPT-DATE-IN-5   PIC  9(05).                      DESBD220
00094      05  FILLER REDEFINES WRK-RPT-DATE-IN.                        DESBD220
00095          10  FILLER              PIC  9(05).                      DESBD220
00096          10  WRK-RPT-DATE-IN-3   PIC  9(03).                      DESBD220
00097                                                                   DESBD220
00098  01  R102-REC.                                                    DESBD220
00099  ++INCLUDE DESIR102                                               DESBD220
00100      EJECT                                                        DESBD220
00101  01  R901-REC.                                                    DESBD220
00102  ++INCLUDE DTSIR901                                               DESBD220
00103      EJECT                                                        DESBD220
00104  01  L112-LINK-AREA.                                              DESBD220
00105  ++INCLUDE DTSIL112                                               DESBD220
00106      EJECT                                                        DESBD220
00107  01  L921-LINK-AREA.                                              DESBD220
00108  ++INCLUDE DTSIL921                                               DESBD220
00109      EJECT                                                        DESBD220
00110  01  ISKL-REC.                                                    DESBD220
00111  ++INCLUDE DTSIISKL                                               DESBD220
00112      EJECT                                                        DESBD220
00113  01  IEET-REC.                                                    DESBD220
00114  ++INCLUDE DTSIIEET                                               DESBD220
00115      EJECT                                                        DESBD220
00116  01  L935-LINK-AREA.                                              DESBD220
00117  ++INCLUDE DTSIL935                                               DESBD220
00118      EJECT                                                        DESBD220
00119  01  ESKL-REC.                                                    DESBD220
00120  ++INCLUDE DTSIESKL                                               DESBD220
00121      EJECT                                                        DESBD220
00122  01  EPRF-REC.                                                    DESBD220
00123  ++INCLUDE DTSIEPRF                                               DESBD220
00124      EJECT                                                        DESBD220
00125  01  ELOG-REC.                                                    DESBD220
00126  ++INCLUDE DTSIELOG                                               DESBD220
00127      EJECT                                                        DESBD220
00128  01  EMSG-REC.                                                    DESBD220
00129  ++INCLUDE DTSIEMSG                                               DESBD220
00130      EJECT                                                        DESBD220
00131  01  EEMH-REC.                                                    DESBD220
00132  ++INCLUDE DTSIEEMH                                               DESBD220
00133      EJECT                                                        DESBD220
00134  01  L941-LINK-AREA.                                              DESBD220
00135  ++INCLUDE DTSIL941                                               DESBD220
00136      EJECT                                                        DESBD220
00137  01  RSK4-REC.                                                    DESBD220
00138  ++INCLUDE DTSIRSK4                                               DESBD220
00139      EJECT                                                        DESBD220
00140                                                                   DESBD220
00141  PROCEDURE DIVISION.                                              DESBD220
00142                                                                   DESBD220
00143  DESBD220-MAIN.                                                   DESBD220
00144                                                                   DESBD220
00145      SET WRK-FATAL-ERROR-NO             TO TRUE.                  DESBD220
00146                                                                   DESBD220
00147      PERFORM I0000-INIT              THRU I0000-EXIT              DESBD220
00148      IF WRK-FATAL-ERROR-YES                                       DESBD220
00149         GO TO DESBD220-EXIT.                                      DESBD220
00150                                                                   DESBD220
00151      PERFORM P1000-INPUT-LOOP     THRU P1000-EXIT                 DESBD220
00152         UNTIL L941-NO-REC-88.                                     DESBD220
00153                                                                   DESBD220
00154      PERFORM T0000-TERMINATE   THRU T0000-EXIT.                   DESBD220
00155                                                                   DESBD220
00156  DESBD220-EXIT.                                                   DESBD220
00157                                                                   DESBD220
00158      GOBACK.                                                      DESBD220
00159                                                                   DESBD220
00160 ******************************************************************DESBD220
00161 *     OPEN FILES AND INITIALIZE WORKING-STORAGE AND LINKAGE.     *DESBD220
00162 *     IF THE EDIT PROGAM HAS ATTEMPTED TO PROCESS THIS ITEM      *DESBD220
00163 *     PREVIOUSLY, AND IS NOW BEING RE-RUN,                        DESBD220
00164 *     DELETE ANY ERROR MESSAGE RECORDS AND EMPLOYER              *DESBD220
00165 *     HISTORY RECORDS FROM THE PREVIOUS RUN.                      DESBD220
00166 ******************************************************************DESBD220
00167  I0000-INIT.                                                      DESBD220
00168      PERFORM I2000-INIT-RPTS           THRU I2000-EXIT.           DESBD220
00169                                                                   DESBD220
00170      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DESBD220
00171      IF WRK-FATAL-ERROR-YES                                       DESBD220
00172         GO TO I0000-EXIT.                                         DESBD220
00173                                                                   DESBD220
00174  I0000-EXIT.                                                      DESBD220
00175      EXIT.                                                        DESBD220
00176                                                                   DESBD220
00177  I1000-OPEN-FILES.                                                DESBD220
00178      MOVE ' ' TO WRK-TRACE-IND.                                   DESBD220
00179                                                                   DESBD220
00180      MOVE WRK-TRACE-IND TO L921-TRACE-IND                         DESBD220
00181                            L935-TRACE-IND                         DESBD220
00182                            L941-TRACE-IND.                        DESBD220
00183                                                                   DESBD220
00184      MOVE WRK-MOD-NAME TO L921-MOD-NAME                           DESBD220
00185                           L935-MOD-NAME                           DESBD220
00186                           L941-MOD-NAME.                          DESBD220
00187                                                                   DESBD220
00188      MOVE ZERO         TO WRK-TOT-CNT                             DESBD220
00189                           WRK-EMP-CNT                             DESBD220
00190                           WRK-SUCCESS-CNT.                        DESBD220
00191                                                                   DESBD220
00192      PERFORM S921-OPEN-UPDATE THRU S921-EXIT.                     DESBD220
00193      PERFORM S935-OPEN-UPDATE THRU S935-EXIT.                     DESBD220
00194      PERFORM S941-OPEN-READ   THRU S941-EXIT.                     DESBD220
00195                                                                   DESBD220
00196  I1000-EXIT.                                                      DESBD220
00197      EXIT.                                                        DESBD220
00198                                                                   DESBD220
00199  I2000-INIT-RPTS.                                                 DESBD220
00200      MOVE LENGTH OF R102-REC        TO R102-LENGTH.               DESBD220
00201      MOVE '102'                     TO R102-REC-TYPE.             DESBD220
00202      MOVE LENGTH OF R901-REC        TO R901-LENGTH.               DESBD220
00203      MOVE '901'                     TO R901-REC-TYPE.             DESBD220
00204      MOVE SPACES                    TO R102-BOX-NO                DESBD220
00205                                        R102-RPT-TYPE              DESBD220
00206                                        R102-FORMAT-CD             DESBD220
00207                                        R102-OPID                  DESBD220
00208                                        R102-FMT-ADDR              DESBD220
00209                                        R102-ZIP                   DESBD220
00210                                        R102-ADVANCED-BARCODE.     DESBD220
00211                                                                   DESBD220
00212      MOVE ZERO                      TO R102-ELF-ID                DESBD220
00213                                        R102-LOG-NO                DESBD220
00214                                        R102-MAIL-DATE             DESBD220
00215                                        R102-ERR-CNT.              DESBD220
00216                                                                   DESBD220
00217      PERFORM I2100-ERR-TABLE        THRU I2100-EXIT               DESBD220
00218         VARYING ERR-SUB FROM +1 BY +1                             DESBD220
00219         UNTIL ERR-SUB > +50.                                      DESBD220
00220                                                                   DESBD220
00221  I2000-EXIT.                                                      DESBD220
00222      EXIT.                                                        DESBD220
00223                                                                   DESBD220
00224                                                                   DESBD220
00225  I2100-ERR-TABLE.                                                 DESBD220
00226      MOVE SPACES          TO R102-ERR-TABLE (ERR-SUB).            DESBD220
00227                                                                   DESBD220
00228  I2100-EXIT.                                                      DESBD220
00229      EXIT.                                                        DESBD220
00230                                                                   DESBD220
00231  P1000-INPUT-LOOP.                                                DESBD220
00232      PERFORM S941-READ-NEXT THRU S941-EXIT.                       DESBD220
00233      IF L941-NO-REC-88                                            DESBD220
00234         PERFORM P1200-COMPLETE-R102      THRU P1200-EXIT          DESBD220
00235         PERFORM P1300-BUILD-R901         THRU P1300-EXIT          DESBD220
00236         GO TO P1000-EXIT                                          DESBD220
00237      ELSE                                                         DESBD220
00238         IF RSK4-LOG-NO = ZERO                                     DESBD220
00239         GO TO P1000-EXIT.                                         DESBD220
00240                                                                   DESBD220
00241      IF WRK-LOG-NO NOT = RSK4-LOG-NO                              DESBD220
00242         PERFORM P1200-COMPLETE-R102      THRU P1200-EXIT          DESBD220
00243         PERFORM P1300-BUILD-R901         THRU P1300-EXIT          DESBD220
00244         PERFORM I2000-INIT-RPTS          THRU I2000-EXIT          DESBD220
00245         MOVE RSK4-LOG-NO                 TO WRK-LOG-NO            DESBD220
00246         PERFORM P2000-CHK-PRIOR-RUN      THRU P2000-EXIT          DESBD220
00247         PERFORM P3000-BUILD-R102         THRU P3000-EXIT.         DESBD220
00248                                                                   DESBD220
00249      MOVE RSK4-REC-AREA  TO ESKL-REC.                             DESBD220
00250      IF ESKL-MSG-88                                               DESBD220
00251         MOVE ESKL-REC TO EMSG-REC                                 DESBD220
00252         PERFORM P1100-ERR-TO-R102        THRU P1100-EXIT          DESBD220
00253      ELSE                                                         DESBD220
00254      IF ESKL-EMH-88                                               DESBD220
00255         MOVE ESKL-REC TO EEMH-REC                                 DESBD220
00256         PERFORM S935-WRITE-CHK-DUP-KEY   THRU S935-EXIT           DESBD220
00257         IF L935-OK-88                                             DESBD220
00258         OR L935-DUP-KEY-88                                        DESBD220
00259            NEXT SENTENCE                                          DESBD220
00260         ELSE                                                      DESBD220
00261            DISPLAY 'CANNOT WRITE RECORD ' ESKL-REC-TYPE.          DESBD220
00262                                                                   DESBD220
00263  P1000-EXIT.                                                      DESBD220
00264      EXIT.                                                        DESBD220
00265                                                                   DESBD220
00266  P1100-ERR-TO-R102.                                               DESBD220
00267      IF EMSG-TYPE-ERROR-88                                        DESBD220
00268         IF ERR-SUB < +50                                          DESBD220
00269            ADD +1                  TO ERR-SUB                     DESBD220
00270            MOVE EMSG-FULL-MESSAGE  TO R102-ERROR (ERR-SUB)        DESBD220
00271            MOVE ERR-SUB            TO R102-ERR-CNT.               DESBD220
00272                                                                   DESBD220
00273  P1100-EXIT.                                                      DESBD220
00274      EXIT.                                                        DESBD220
00275                                                                   DESBD220
00276  P1200-COMPLETE-R102.                                             DESBD220
00277      IF WRK-LOG-NO = ZERO                                         DESBD220
00278         PERFORM P1210-NO-INPUT-RECS  THRU P1210-EXIT              DESBD220
00279         GO TO P1200-EXIT.                                         DESBD220
00280                                                                   DESBD220
00281      IF ERR-SUB = ZERO                                            DESBD220
00282         SET R102-RPT-TYPE-CONFIRM-88 TO TRUE                      DESBD220
00283      ELSE                                                         DESBD220
00284         SET R102-RPT-TYPE-ERROR-88 TO TRUE.                       DESBD220
00285                                                                   DESBD220
00286      PERFORM S946-WRITE-R102 THRU S946-EXIT.                      DESBD220
00287                                                                   DESBD220
00288  P1200-EXIT.                                                      DESBD220
00289      EXIT.                                                        DESBD220
00290                                                                   DESBD220
00291  P1210-NO-INPUT-RECS.                                             DESBD220
00292      MOVE SPACES                  TO R102-BOX-NO                  DESBD220
00293                                      R102-FORMAT-CD               DESBD220
00294                                      R102-OPID                    DESBD220
00295                                      R102-FMT-ADDR                DESBD220
00296                                      R102-ADVANCED-BARCODE.       DESBD220
00297                                                                   DESBD220
00298      MOVE ZERO                    TO R102-ELF-ID                  DESBD220
00299                                      R102-LOG-NO                  DESBD220
00300                                      R102-MAIL-DATE.              DESBD220
00301                                                                   DESBD220
00302      MOVE WRK-NO-INPUT-MSG        TO R102-ERROR (1).              DESBD220
00303      MOVE +1                      TO R102-ERR-CNT.                DESBD220
00304                                                                   DESBD220
00305      SET R102-RPT-TYPE-ERROR-88 TO TRUE.                          DESBD220
00306                                                                   DESBD220
00307      PERFORM S946-WRITE-R102 THRU S946-EXIT.                      DESBD220
00308                                                                   DESBD220
00309  P1210-EXIT.                                                      DESBD220
00310      EXIT.                                                        DESBD220
00311                                                                   DESBD220
00312  P1300-BUILD-R901.                                                DESBD220
00313      IF WRK-LOG-NO = ZERO                                         DESBD220
00314         GO TO P1300-EXIT.                                         DESBD220
00315                                                                   DESBD220
00316      IF (EPRF-PRT-UC30-88 OR EPRF-BEN-CHARGE-88)                  DESBD220
00317          NEXT SENTENCE                                            DESBD220
00318      ELSE                                                         DESBD220
00319         IF EPRF-WAGE-88                                           DESBD220
00320            IF EPRF-TAPE-88                                        DESBD220
00321               NEXT SENTENCE                                       DESBD220
00322            ELSE                                                   DESBD220
00323               GO TO P1300-EXIT                                    DESBD220
00324            END-IF                                                 DESBD220
00325         ELSE                                                      DESBD220
00326            GO TO P1300-EXIT                                       DESBD220
00327         END-IF                                                    DESBD220
00328      END-IF.                                                      DESBD220
00329                                                                   DESBD220
00330      SET R901-ON-REQUEST-88     TO TRUE.                          DESBD220
00331      MOVE WRK-MOD-NAME          TO R901-GRP1-OP-ID.               DESBD220
00332      MOVE EPRF-ELF-ID           TO R901-GRP1-EMP-NO               DESBD220
00333                                    R901-EMP-NO.                   DESBD220
00334      MOVE +1                    TO R901-LABEL-CNT.                DESBD220
00335      MOVE L112-ZIP              TO R901-ZIP.                      DESBD220
00336      MOVE L112-MAILING-ADDRESS  TO R901-FMT-ADDR.                 DESBD220
00337      MOVE L112-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE.         DESBD220
00338                                                                   DESBD220
00339      PERFORM S946-WRITE-R901 THRU S946-EXIT.                      DESBD220
00340                                                                   DESBD220
00341  P1300-EXIT.                                                      DESBD220
00342      EXIT.                                                        DESBD220
00343                                                                   DESBD220
00344  P2000-CHK-PRIOR-RUN.                                             DESBD220
00345      PERFORM P2100-DELETE-EEMH         THRU P2100-EXIT.           DESBD220
00346      PERFORM P2200-DELETE-EMSG         THRU P2200-EXIT.           DESBD220
00347                                                                   DESBD220
00348  P2000-EXIT.                                                      DESBD220
00349      EXIT.                                                        DESBD220
00350                                                                   DESBD220
00351 ******************************************************************DESBD220
00352 *           DELETE THE HISTORY RECORD                            *DESBD220
00353 *           USING THE ALTERNATE INDEX IEET FILE                  *DESBD220
00354 ******************************************************************DESBD220
00355  P2100-DELETE-EEMH.                                               DESBD220
00356      MOVE LOW-VALUES                   TO IEET-KEY-AREA.          DESBD220
00357      SET IEET-EET-88                   TO TRUE.                   DESBD220
00358      MOVE +0                           TO IEET-EMP-NO             DESBD220
00359                                           IEET-RPT-DATE-XOR.      DESBD220
00360      MOVE SPACES                       TO IEET-DATA-TYPE-CD.      DESBD220
00361      MOVE ZERO                         TO IEET-LOG-NO.            DESBD220
00362      MOVE IEET-REC                     TO ISKL-REC.               DESBD220
00363                                                                   DESBD220
00364      PERFORM S921-START-BROWSE         THRU S921-EXIT.            DESBD220
00365      IF L921-NO-REC-88                                            DESBD220
00366           NEXT SENTENCE                                           DESBD220
00367      ELSE                                                         DESBD220
00368        PERFORM P2110-SCAN-IEET         THRU P2110-EXIT            DESBD220
00369          UNTIL L921-NO-REC-88                                     DESBD220
00370      END-IF.                                                      DESBD220
00371                                                                   DESBD220
00372  P2100-EXIT.                                                      DESBD220
00373      EXIT.                                                        DESBD220
00374                                                                   DESBD220
00375  P2110-SCAN-IEET.                                                 DESBD220
00376                                                                   DESBD220
00377      MOVE ISKL-REC                     TO IEET-REC.               DESBD220
00378      IF IEET-LOG-NO = WRK-LOG-NO                                  DESBD220
00379         PERFORM P2111-DELETE-EEMH      THRU P2111-EXIT            DESBD220
00380         PERFORM S921-START-BROWSE      THRU S921-EXIT             DESBD220
00381         GO TO P2110-EXIT                                          DESBD220
00382      END-IF.                                                      DESBD220
00383                                                                   DESBD220
00384      PERFORM S921-READ-NEXT            THRU S921-EXIT.            DESBD220
00385                                                                   DESBD220
00386  P2110-EXIT.                                                      DESBD220
00387      EXIT.                                                        DESBD220
00388                                                                   DESBD220
00389  P2111-DELETE-EEMH.                                               DESBD220
00390      MOVE LOW-VALUES                   TO EEMH-REC.               DESBD220
00391      SET EEMH-EMH-88                   TO TRUE.                   DESBD220
00392      MOVE IEET-EMP-NO                  TO EEMH-EMP-NO.            DESBD220
00393      COMPUTE EEMH-REPORTING-DATE =                                DESBD220
00394           (99999999 - IEET-RPT-DATE-XOR).                         DESBD220
00395      MOVE IEET-DATA-TYPE-CD            TO EEMH-DATA-TYPE-CD.      DESBD220
00396      MOVE IEET-LOG-NO                  TO EEMH-LOG-NO.            DESBD220
00397      MOVE EEMH-REC                     TO ESKL-REC.               DESBD220
00398                                                                   DESBD220
00399      PERFORM S935-READ                 THRU S935-EXIT.            DESBD220
00400                                                                   DESBD220
00401      IF L935-NO-REC-88                                            DESBD220
00402         NEXT SENTENCE                                             DESBD220
00403      ELSE                                                         DESBD220
00404         PERFORM S935-DELETE             THRU S935-EXIT            DESBD220
00405         ADD +1 TO WRK-EEMH-REC-DELETE                             DESBD220
00406      END-IF.                                                      DESBD220
00407                                                                   DESBD220
00408      PERFORM S921-READ-NEXT            THRU S921-EXIT.            DESBD220
00409                                                                   DESBD220
00410  P2111-EXIT.                                                      DESBD220
00411      EXIT.                                                        DESBD220
00412                                                                   DESBD220
00413 ******************************************************************DESBD220
00414 *           DELETE ANY ERROR MESSAGE RECORD                      *DESBD220
00415 *           WHEN EMSG-LOG-NO = ELOG-LOG-NO                       *DESBD220
00416 ******************************************************************DESBD220
00417  P2200-DELETE-EMSG.                                               DESBD220
00418      MOVE LOW-VALUES                   TO EMSG-REC.               DESBD220
00419      SET EMSG-MSG-88                   TO TRUE.                   DESBD220
00420      MOVE WRK-LOG-NO                   TO EMSG-LOG-NO.            DESBD220
00421      MOVE +0                           TO EMSG-ABSTIME.           DESBD220
00422      MOVE ZERO                         TO EMSG-SEQ.               DESBD220
00423      MOVE EMSG-REC                     TO ESKL-REC.               DESBD220
00424                                                                   DESBD220
00425      PERFORM S935-START-BROWSE         THRU S935-EXIT.            DESBD220
00426      IF L935-NO-REC-88                                            DESBD220
00427         NEXT SENTENCE                                             DESBD220
00428      ELSE                                                         DESBD220
00429        PERFORM P2210-DELETE            THRU P2210-EXIT            DESBD220
00430           UNTIL L935-NO-REC-88                                    DESBD220
00431      END-IF.                                                      DESBD220
00432                                                                   DESBD220
00433  P2200-EXIT.                                                      DESBD220
00434      EXIT.                                                        DESBD220
00435                                                                   DESBD220
00436  P2210-DELETE.                                                    DESBD220
00437      MOVE ESKL-REC                     TO EMSG-REC.               DESBD220
00438      IF EMSG-LOG-NO = WRK-LOG-NO                                  DESBD220
00439         IF EMSG-TYPE-ERROR-88                                     DESBD220
00440            PERFORM S935-DELETE         THRU S935-EXIT             DESBD220
00441            ADD +1 TO WRK-EMSG-REC-DELETE                          DESBD220
00442         END-IF                                                    DESBD220
00443      END-IF.                                                      DESBD220
00444                                                                   DESBD220
00445      PERFORM S935-READ-NEXT             THRU S935-EXIT.           DESBD220
00446                                                                   DESBD220
00447  P2210-EXIT.                                                      DESBD220
00448      EXIT.                                                        DESBD220
00449                                                                   DESBD220
00450  P3000-BUILD-R102.                                                DESBD220
00451      PERFORM P3100-READ-LOG            THRU P3100-EXIT.           DESBD220
00452      PERFORM P3200-READ-PRF            THRU P3200-EXIT.           DESBD220
00453      PERFORM P3300-FORMAT-R102         THRU P3300-EXIT.           DESBD220
00454                                                                   DESBD220
00455  P3000-EXIT.                                                      DESBD220
00456      EXIT.                                                        DESBD220
00457                                                                   DESBD220
00458  P3100-READ-LOG.                                                  DESBD220
00459      MOVE LOW-VALUES                   TO ELOG-REC.               DESBD220
00460      MOVE WRK-LOG-NO                   TO ELOG-LOG-NO.            DESBD220
00461      SET ELOG-LOG-88                   TO TRUE.                   DESBD220
00462      MOVE ELOG-KEY-AREA                TO ESKL-KEY-AREA.          DESBD220
00463                                                                   DESBD220
00464      PERFORM S935-READ                 THRU S935-EXIT.            DESBD220
00465      IF L935-NO-REC-88                                            DESBD220
00466         DISPLAY 'CANNOT FIND LOG RECORD'                          DESBD220
00467         PERFORM S999-ABEND   THRU S999-EXIT                       DESBD220
00468      ELSE                                                         DESBD220
00469         MOVE ESKL-REC                  TO ELOG-REC.               DESBD220
00470                                                                   DESBD220
00471  P3100-EXIT.                                                      DESBD220
00472      EXIT.                                                        DESBD220
00473                                                                   DESBD220
00474  P3200-READ-PRF.                                                  DESBD220
00475      MOVE LOW-VALUES                   TO EPRF-REC.               DESBD220
00476      MOVE ELOG-ELF-ID                  TO EPRF-ELF-ID.            DESBD220
00477      MOVE ELOG-DATA-TYPE-CD            TO EPRF-DATA-TYPE-CD.      DESBD220
00478      SET EPRF-PRF-88                   TO TRUE.                   DESBD220
00479      MOVE EPRF-KEY-AREA                TO ESKL-KEY-AREA.          DESBD220
00480                                                                   DESBD220
00481      PERFORM S935-READ                 THRU S935-EXIT.            DESBD220
00482                                                                   DESBD220
00483      IF L935-NO-REC-88                                            DESBD220
00484         DISPLAY 'CANNOT FIND PRF RECORD'                          DESBD220
00485         PERFORM S999-ABEND   THRU S999-EXIT                       DESBD220
00486      ELSE                                                         DESBD220
00487         MOVE ESKL-REC                  TO EPRF-REC.               DESBD220
00488                                                                   DESBD220
00489  P3200-EXIT.                                                      DESBD220
00490      EXIT.                                                        DESBD220
00491                                                                   DESBD220
00492  P3300-FORMAT-R102.                                               DESBD220
00493      MOVE ELOG-BOX-NO                  TO R102-BOX-NO.            DESBD220
00494      MOVE EPRF-ELF-ID                  TO R102-ELF-ID.            DESBD220
00495      MOVE WRK-LOG-NO                   TO R102-LOG-NO.            DESBD220
00496      MOVE EPRF-FORMAT-CD               TO R102-FORMAT-CD.         DESBD220
00497      MOVE ELOG-CHNG-OPID               TO R102-OPID.              DESBD220
00498                                                                   DESBD220
00499      SET L112-FID-MAILING-ADDR-88 TO TRUE.                        DESBD220
00500      SET L112-ANCHOR-FIRST-88     TO TRUE.                        DESBD220
00501      MOVE EPRF-ELF-NAME           TO L112-NAME.                   DESBD220
00502      MOVE EPRF-ADDRESS            TO L112-ADDRESS.                DESBD220
00503      PERFORM S112-ADDR-FORMAT     THRU S112-EXIT.                 DESBD220
00504      MOVE L112-MAILING-ADDRESS    TO R102-FMT-ADDR.               DESBD220
00505      MOVE L112-ADVANCED-BARCODE   TO R102-ADVANCED-BARCODE.       DESBD220
00506      MOVE ZERO                TO R102-MAIL-DATE.                  DESBD220
00507      MOVE ZERO               TO ERR-SUB.                          DESBD220
00508                                                                   DESBD220
00509  P3300-EXIT.                                                      DESBD220
00510      EXIT.                                                        DESBD220
00511                                                                   DESBD220
00512  T0000-TERMINATE.                                                 DESBD220
00513      DISPLAY 'DESBD220 TERMINATION STATISTICS'                    DESBD220
00514      DISPLAY 'EMH RECORDS DELETED ' WRK-EEMH-REC-DELETE.          DESBD220
00515      DISPLAY 'MSG RECORDS DELETED ' WRK-EMSG-REC-DELETE.          DESBD220
00516      PERFORM T4000-CLOSE-FILES   THRU T4000-EXIT.                 DESBD220
00517                                                                   DESBD220
00518  T0000-EXIT.                                                      DESBD220
00519      EXIT.                                                        DESBD220
00520      EJECT                                                        DESBD220
00521                                                                   DESBD220
00522  T4000-CLOSE-FILES.                                               DESBD220
00523                                                                   DESBD220
00524      PERFORM S921-CLOSE       THRU S921-EXIT.                     DESBD220
00525      PERFORM S935-CLOSE       THRU S935-EXIT.                     DESBD220
00526      PERFORM S941-CLOSE       THRU S941-EXIT.                     DESBD220
00527                                                                   DESBD220
00528  T4000-EXIT.                                                      DESBD220
00529      EXIT.                                                        DESBD220
00530                                                                   DESBD220
00531  S112-ADDR-FORMAT.                                                DESBD220
00532      CALL 'DTSBU112' USING L112-LINK-AREA.                        DESBD220
00533                                                                   DESBD220
00534  S112-EXIT.                                                       DESBD220
00535      EXIT.                                                        DESBD220
00536                                                                   DESBD220
00537  S921-OPEN-UPDATE.                                                DESBD220
00538      SET L921-OPEN-UPDATE-88  TO TRUE.                            DESBD220
00539      GO TO S921-AIX-IO.                                           DESBD220
00540                                                                   DESBD220
00541  S921-READ.                                                       DESBD220
00542      SET L921-READ-88         TO TRUE.                            DESBD220
00543      GO TO S921-AIX-IO.                                           DESBD220
00544                                                                   DESBD220
00545  S921-START-BROWSE.                                               DESBD220
00546      SET L921-START-BROWSE-88 TO TRUE.                            DESBD220
00547      GO TO S921-AIX-IO.                                           DESBD220
00548                                                                   DESBD220
00549  S921-READ-NEXT.                                                  DESBD220
00550      SET L921-READ-NEXT-88    TO TRUE.                            DESBD220
00551      GO TO S921-AIX-IO.                                           DESBD220
00552                                                                   DESBD220
00553  S921-DELETE.                                                     DESBD220
00554      SET L921-DELETE-88       TO TRUE.                            DESBD220
00555      GO TO S921-AIX-IO.                                           DESBD220
00556                                                                   DESBD220
00557  S921-CLOSE.                                                      DESBD220
00558      SET L921-CLOSE-88        TO TRUE.                            DESBD220
00559      GO TO S921-AIX-IO.                                           DESBD220
00560                                                                   DESBD220
00561  S921-AIX-IO.                                                     DESBD220
00562      CALL 'DTSBU921' USING L921-LINK-AREA                         DESBD220
00563                            ISKL-REC.                              DESBD220
00564  S921-EXIT.                                                       DESBD220
00565      EXIT.                                                        DESBD220
00566      SKIP3                                                        DESBD220
00567                                                                   DESBD220
00568  S935-OPEN-READ.                                                  DESBD220
00569      SET L935-OPEN-READ-88 TO TRUE.                               DESBD220
00570      GO TO S935-ELF-IO.                                           DESBD220
00571                                                                   DESBD220
00572  S935-OPEN-UPDATE.                                                DESBD220
00573      SET L935-OPEN-UPDATE-88  TO TRUE.                            DESBD220
00574      GO TO S935-ELF-IO.                                           DESBD220
00575                                                                   DESBD220
00576  S935-OPEN-UPDATE-NO-AIX.                                         DESBD220
00577      SET L935-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DESBD220
00578      GO TO S935-ELF-IO.                                           DESBD220
00579                                                                   DESBD220
00580  S935-READ.                                                       DESBD220
00581      SET L935-READ-88 TO TRUE.                                    DESBD220
00582      GO TO S935-ELF-IO.                                           DESBD220
00583                                                                   DESBD220
00584  S935-START-BROWSE.                                               DESBD220
00585      SET L935-START-BROWSE-88 TO TRUE.                            DESBD220
00586      GO TO S935-ELF-IO.                                           DESBD220
00587                                                                   DESBD220
00588  S935-READ-NEXT.                                                  DESBD220
00589      SET L935-READ-NEXT-88 TO TRUE.                               DESBD220
00590      GO TO S935-ELF-IO.                                           DESBD220
00591                                                                   DESBD220
00592  S935-WRITE.                                                      DESBD220
00593      SET L935-WRITE-88        TO TRUE.                            DESBD220
00594      GO TO S935-ELF-IO.                                           DESBD220
00595                                                                   DESBD220
00596  S935-WRITE-CHK-DUP-KEY.                                          DESBD220
00597      SET L935-WRITE-CHK-DUP-KEY-88  TO TRUE.                      DESBD220
00598      GO TO S935-ELF-IO.                                           DESBD220
00599                                                                   DESBD220
00600  S935-REWRITE.                                                    DESBD220
00601      SET L935-REWRITE-88      TO TRUE.                            DESBD220
00602      GO TO S935-ELF-IO.                                           DESBD220
00603                                                                   DESBD220
00604  S935-DELETE.                                                     DESBD220
00605      SET L935-DELETE-88       TO TRUE.                            DESBD220
00606      GO TO S935-ELF-IO.                                           DESBD220
00607                                                                   DESBD220
00608  S935-CLOSE.                                                      DESBD220
00609      SET L935-CLOSE-88        TO TRUE.                            DESBD220
00610      GO TO S935-ELF-IO.                                           DESBD220
00611                                                                   DESBD220
00612  S935-ELF-IO.                                                     DESBD220
00613      CALL 'DTSBU935' USING L935-LINK-AREA                         DESBD220
00614                            ESKL-REC.                              DESBD220
00615  S935-EXIT.                                                       DESBD220
00616      EXIT.                                                        DESBD220
00617      SKIP3                                                        DESBD220
00618                                                                   DESBD220
00619  S941-OPEN-READ.                                                  DESBD220
00620      SET L941-OPEN-READ-88 TO TRUE.                               DESBD220
00621      GO TO S941-I.                                                DESBD220
00622                                                                   DESBD220
00623  S941-READ-NEXT.                                                  DESBD220
00624      SET L941-READ-NEXT-88 TO TRUE.                               DESBD220
00625      GO TO S941-I.                                                DESBD220
00626                                                                   DESBD220
00627  S941-CLOSE.                                                      DESBD220
00628      SET L941-CLOSE-88     TO TRUE.                               DESBD220
00629      GO TO S941-I.                                                DESBD220
00630                                                                   DESBD220
00631  S941-I.                                                          DESBD220
00632      CALL 'DTSBU941' USING L941-LINK-AREA                         DESBD220
00633                            RSK4-REC.                              DESBD220
00634  S941-EXIT.                                                       DESBD220
00635      EXIT.                                                        DESBD220
00636                                                                   DESBD220
00637  S946-WRITE-R102.                                                 DESBD220
00638      CALL 'DTSBU946' USING R102-REC.                              DESBD220
00639      GO TO S946-EXIT.                                             DESBD220
00640                                                                   DESBD220
00641  S946-WRITE-R901.                                                 DESBD220
00642      CALL 'DTSBU946' USING R901-REC.                              DESBD220
00643                                                                   DESBD220
00644  S946-EXIT.                                                       DESBD220
00645      EXIT.                                                        DESBD220
00646                                                                   DESBD220
00647  S999-ABEND.                                                      DESBD220
00648      DISPLAY '**** DESBD220 ABENDING ' WRK-ABEND-MSG.             DESBD220
00649      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DESBD220
00650  S999-EXIT.                                                       DESBD220
00651      EXIT.                                                        DESBD220
00652                                                                   DESBD220
