00001  IDENTIFICATION DIVISION.                                         05/22/01
00002  PROGRAM-ID.             DESBD200.                                DESBD200
00003 *AUTHOR.                 TRW INC.                                    LV001
00004 *DATE-WRITTEN.           JANUARY 2001.                            DESBD200
00005  DATE-COMPILED.                                                   DESBD200
00006                                                                   DESBD200
00007 *****                                                             DESBD200
00008 *                                                                 DESBD200
00009 *    FUNCTION:                                                    DESBD200
00010 *                                                                 DESBD200
00011 *        INTERFACE BETWEEN PROGRAMS THAT EDIT DATA SUBMITTED      DESBD200
00012 *        ELECTRONICALLY, SUCH AS THE WAGE DATA BY THE FISCAL      DESBD200
00013 *        AGENTS, AND THE ELECTRONIC MEDIA TRACKING SYSTEMS.       DESBD200
00014 *        DESBD200 RECORDS THE START AND END OF THE JOBS,          DESBD200
00015 *        INTERCEPTS INFORMATION ABOUT ANY ERRORS FOUND AND        DESBD200
00016 *        WRITES MESSAGE RECORDS THAT PROVIDE A HISTORY OF         DESBD200
00017 *        THE PROCESS.  IT ALSO UPDATES THE ELOG RECORD, AND       DESBD200
00018 *        ADDS EMPLOYER HISTORY (EEMH) RECORDS IF THE DATE         DESBD200
00019 *        REFER TO SPECIFIC EMPLOYERS.                             DESBD200
00020 *                                                                 DESBD200
00021 *        INPUT:                                                   DESBD200
00022 *                                                                 DESBD200
00023 *            DESIL200 - PROCESSING STATUS PASSED FROM             DESBD200
00024 *                       EDIT PROGRAMS THRU THE LINKAGE SECTION.   DESBD200
00025 *            DTSIC202 - ERROR INFORMATION PASSED FROM             DESBD200
00026 *                       EDIT PROGRAMS THRU THE LINKAGE SECTION.   DESBD200
00027 *            DTSIEPRF - VSAM ELECTRONIC FILER PROFILE.            DESBD200
00028 *                                                                 DESBD200
00029 *       INPUT-OUTPUT;                                             DESBD200
00030 *                                                                 DESBD200
00031 *            DTSIELOG - VSAM LOG FILE.                            DESBD200
00032 *            DTSIEEMH - VSAM HISTORY FILE.                        DESBD200
00033 *            DTSIEMSG - VSAM STATUS AND ERROR MESSAGE FILE.       DESBD200
00034 *                                                                 DESBD200
00035 *****                                                             DESBD200
00036                                                                   DESBD200
00037 ******************************************************************DESBD200
00038 * MODIFICATION HISTORY:                                          *DESBD200
00039 *                                                                *DESBD200
00040 * 12-01-2000 INITIAL DEVELOPMENT                                 *DESBD200
00041 *            REFERENCE RFP #              AUTHOR OF CHANGE - RW  *DESBD200
00042 *                                                                *DESBD200
00043 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD200
00044 *            XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *DESBD200
00045 *            REFERENCE RFP #****          AUTHOR OF CHANGE - *** *DESBD200
00046 ******************************************************************DESBD200
00047                                                                   DESBD200
00048  ENVIRONMENT DIVISION.                                            DESBD200
00049                                                                   DESBD200
00050  DATA DIVISION.                                                   DESBD200
00051                                                                   DESBD200
00052  WORKING-STORAGE SECTION.                                         DESBD200
000525 77  PAN-VALET PICTURE X(24) VALUE '001DESBD200  05/22/01'.       DESBD200
00053                                                                   DESBD200
00054  01  WRK-AREA.                                                    DESBD200
00055      05  WRK-ABEND-CD            PIC S9(04)  COMP  VALUE +200.    DESBD200
00056      05  WRK-ABEND-MSG           PIC  X(60)  VALUE SPACES.        DESBD200
00057                                                                   DESBD200
00058      05  WRK-MOD-NAME            PIC  X(08)  VALUE 'DESBD200'.    DESBD200
00059                                                                   DESBD200
00060      05  WRK-ELOG-REC-UPDATE     PIC S9(07)  COMP-3 VALUE +0.     DESBD200
00061      05  WRK-EEMH-REC-DELETE     PIC S9(07)  COMP-3 VALUE +0.     DESBD200
00062      05  WRK-EMSG-REC-DELETE     PIC S9(07)  COMP-3 VALUE +0.     DESBD200
00063      05  WRK-EMSG-REC-WRITTEN    PIC S9(07)  COMP-3 VALUE +0.     DESBD200
00064                                                                   DESBD200
00065                                                                   DESBD200
00066  01  WRK-VARIABLES.                                               DESBD200
00067      05  WRK-TRACE-IND           PIC  X(01) VALUE SPACE.          DESBD200
00068                                                                   DESBD200
00069      05  WRK-FATAL-ERROR-IND     PIC  X(01) VALUE ' '.            DESBD200
00070          88  WRK-FATAL-ERROR-YES  VALUE 'Y'.                      DESBD200
00071          88  WRK-FATAL-ERROR-NO   VALUE 'N'.                      DESBD200
00072                                                                   DESBD200
00073      05  WRK-LOG-NO              PIC  9(10)        VALUE  0.      DESBD200
00074      05  FILLER REDEFINES WRK-LOG-NO.                             DESBD200
00075          10  WRK-LOG-NO-PFX      PIC  9(04).                      DESBD200
00076          10  WRK-LOG-NO-SFX      PIC  9(06).                      DESBD200
00077                                                                   DESBD200
00078      05  WRK-CURR-DATE           PIC S9(09) COMP-3 VALUE +0.      DESBD200
00079      05  WRK-DISP-DATE           PIC  X(08).                      DESBD200
00080      05  WRK-CURR-TIME           PIC S9(07) COMP-3 VALUE +0.      DESBD200
00081      05  WRK-DISP-TIME           PIC  X(08).                      DESBD200
00082      05  WRK-ABSTIME             PIC S9(15) COMP-3 VALUE +0.      DESBD200
00083      05  WRK-ABSTIME-XOR         PIC S9(15) COMP-3 VALUE +0.      DESBD200
00084                                                                   DESBD200
00085      05  WRK-EMSG-SEQ            PIC  9(05) COMP-3 VALUE  0.      DESBD200
00086      05  WRK-EEMH-SEQ            PIC  9(04) COMP-3 VALUE  0.      DESBD200
00087      05  WRK-TOT-CNT             PIC S9(05) COMP-3 VALUE +0.      DESBD200
00088      05  WRK-EMP-CNT             PIC S9(07) COMP-3 VALUE +0.      DESBD200
00089      05  WRK-LAST-EMP-NO         PIC S9(07) COMP-3 VALUE +0.      DESBD200
00090      05  WRK-SUCCESS-CNT         PIC S9(07) COMP-3 VALUE +0.      DESBD200
00091                                                                   DESBD200
00092      05  WRK-ERR-MESSAGE         PIC  X(60) VALUE SPACES.         DESBD200
00093                                                                   DESBD200
00094      05  WRK-RESULT-CD           PIC  X(02) VALUE ZERO.           DESBD200
00095                                                                   DESBD200
00096      05  WRK-DATE-TYPE           PIC  X(03) VALUE SPACES.         DESBD200
00097      05  WRK-RPT-DATE            PIC  9(08) VALUE 0.              DESBD200
00098      05  WRK-RPT-DATE-IN         PIC  9(08) VALUE 0.              DESBD200
00099      05  FILLER REDEFINES WRK-RPT-DATE-IN.                        DESBD200
00100          10  FILLER              PIC  9(03).                      DESBD200
00101          10  WRK-RPT-DATE-IN-5   PIC  9(05).                      DESBD200
00102      05  FILLER REDEFINES WRK-RPT-DATE-IN.                        DESBD200
00103          10  FILLER              PIC  9(05).                      DESBD200
00104          10  WRK-RPT-DATE-IN-3   PIC  9(03).                      DESBD200
00105                                                                   DESBD200
00106  01  C200-CONSTANTS-AREA.                                         DESBD200
00107  ++INCLUDE DTSIC200                                               DESBD200
00108      EJECT                                                        DESBD200
00109  01  C201-LINK-AREA.                                              DESBD200
00110  ++INCLUDE DTSIC201                                               DESBD200
00111      EJECT                                                        DESBD200
00112  01  L004-LINK-AREA.                                              DESBD200
00113  ++INCLUDE DTSIL004                                               DESBD200
00114      EJECT                                                        DESBD200
00115  01  L005-LINK-AREA.                                              DESBD200
00116  ++INCLUDE DTSIL005                                               DESBD200
00117      EJECT                                                        DESBD200
00118  01  L222-LINK-AREA.                                              DESBD200
00119  ++INCLUDE DTSIL222                                               DESBD200
00120      EJECT                                                        DESBD200
00121  01  L921-LINK-AREA.                                              DESBD200
00122  ++INCLUDE DTSIL921                                               DESBD200
00123      EJECT                                                        DESBD200
00124  01  ISKL-REC.                                                    DESBD200
00125  ++INCLUDE DTSIISKL                                               DESBD200
00126      EJECT                                                        DESBD200
00127  01  IEAL-REC.                                                    DESBD200
00128  ++INCLUDE DTSIIEAL                                               DESBD200
00129      EJECT                                                        DESBD200
00130  01  L935-LINK-AREA.                                              DESBD200
00131  ++INCLUDE DTSIL935                                               DESBD200
00132      EJECT                                                        DESBD200
00133  01  ESKL-REC.                                                    DESBD200
00134  ++INCLUDE DTSIESKL                                               DESBD200
00135      EJECT                                                        DESBD200
00136  01  EPRF-REC.                                                    DESBD200
00137  ++INCLUDE DTSIEPRF                                               DESBD200
00138      EJECT                                                        DESBD200
00139  01  ELOG-REC.                                                    DESBD200
00140  ++INCLUDE DTSIELOG                                               DESBD200
00141      EJECT                                                        DESBD200
00142  01  EMSG-REC.                                                    DESBD200
00143  ++INCLUDE DTSIEMSG                                               DESBD200
00144      EJECT                                                        DESBD200
00145  01  EEMH-REC.                                                    DESBD200
00146  ++INCLUDE DTSIEEMH                                               DESBD200
00147      EJECT                                                        DESBD200
00148  01  L941-LINK-AREA.                                              DESBD200
00149  ++INCLUDE DTSIL941                                               DESBD200
00150      EJECT                                                        DESBD200
00151  01  RSK4-REC.                                                    DESBD200
00152  ++INCLUDE DTSIRSK4                                               DESBD200
00153      EJECT                                                        DESBD200
00154                                                                   DESBD200
00155  LINKAGE SECTION.                                                 DESBD200
00156                                                                   DESBD200
00157  01  L200-LINK-AREA.                                              DESBD200
00158  ++INCLUDE DESIL200                                               DESBD200
00159                                                                   DESBD200
00160  01  C202-LINK-AREA.                                              DESBD200
00161  ++INCLUDE DTSIC202                                               DESBD200
00162                                                                   DESBD200
00163  PROCEDURE DIVISION  USING L200-LINK-AREA                         DESBD200
00164                            C202-LINK-AREA.                        DESBD200
00165                                                                   DESBD200
00166  DESBD200-MAIN.                                                   DESBD200
00167                                                                   DESBD200
00168      SET WRK-FATAL-ERROR-NO             TO TRUE.                  DESBD200
00169                                                                   DESBD200
00170      IF L200-CMD-INIT-88                                          DESBD200
00171         PERFORM I0000-INIT              THRU I0000-EXIT           DESBD200
00172         IF WRK-FATAL-ERROR-NO                                     DESBD200
00173            PERFORM P2000-WRITE-EMSG     THRU P2000-EXIT           DESBD200
00174         END-IF                                                    DESBD200
00175      ELSE                                                         DESBD200
00176         IF L200-CMD-EMP-COMPLETE-88                               DESBD200
00177            PERFORM P3000-EMP-COMPLETE   THRU P3000-EXIT           DESBD200
00178         ELSE                                                      DESBD200
00179            IF L200-CMD-TERMINATE-88                               DESBD200
00180               PERFORM T0000-TERMINATE   THRU T0000-EXIT           DESBD200
00181            ELSE                                                   DESBD200
00182               DISPLAY 'INVALID L200-COMMAND-CD VALUE '            DESBD200
00183            END-IF                                                 DESBD200
00184         END-IF                                                    DESBD200
00185      END-IF.                                                      DESBD200
00186                                                                   DESBD200
00187  DESBD200-EXIT.                                                   DESBD200
00188                                                                   DESBD200
00189      GOBACK.                                                      DESBD200
00190                                                                   DESBD200
00191 ******************************************************************DESBD200
00192 *     OPEN FILES AND INITIALIZE WORKING-STORAGE AND LINKAGE.     *DESBD200
00193 *     IF THE EDIT PROGAM HAS ATTEMPTED TO PROCESS THIS ITEM      *DESBD200
00194 *     PREVIOUSLY, AND IS NOW BEING RE-RUN,                        DESBD200
00195 *     DELETE ANY ERROR MESSAGE RECORDS AND EMPLOYER              *DESBD200
00196 *     HISTORY RECORDS FROM THE PREVIOUS RUN.                      DESBD200
00197 ******************************************************************DESBD200
00198  I0000-INIT.                                                      DESBD200
00199                                                                   DESBD200
00200      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DESBD200
00201      PERFORM I2000-DATE-TIME           THRU I2000-EXIT.           DESBD200
00202      PERFORM I3000-INIT-ERR-TAB        THRU I3000-EXIT.           DESBD200
00203      PERFORM I4000-GET-LOG             THRU I4000-EXIT.           DESBD200
00204      IF WRK-FATAL-ERROR-YES                                       DESBD200
00205         GO TO I0000-EXIT.                                         DESBD200
00206                                                                   DESBD200
00207  I0000-EXIT.                                                      DESBD200
00208      EXIT.                                                        DESBD200
00209                                                                   DESBD200
00210  I1000-OPEN-FILES.                                                DESBD200
00211      MOVE ' ' TO WRK-TRACE-IND.                                   DESBD200
00212                                                                   DESBD200
00213      MOVE WRK-TRACE-IND TO L921-TRACE-IND                         DESBD200
00214                            L935-TRACE-IND.                        DESBD200
00215                                                                   DESBD200
00216      MOVE WRK-MOD-NAME TO L921-MOD-NAME                           DESBD200
00217                           L935-MOD-NAME.                          DESBD200
00218                                                                   DESBD200
00219      MOVE ZERO         TO WRK-TOT-CNT                             DESBD200
00220                           WRK-EMP-CNT                             DESBD200
00221                           WRK-SUCCESS-CNT.                        DESBD200
00222                                                                   DESBD200
00223      PERFORM S921-OPEN-READ   THRU S921-EXIT.                     DESBD200
00224      PERFORM S935-OPEN-READ   THRU S935-EXIT.                     DESBD200
00225                                                                   DESBD200
00226  I1000-EXIT.                                                      DESBD200
00227      EXIT.                                                        DESBD200
00228                                                                   DESBD200
00229 ******************************************************************DESBD200
00230 *        GET CURRENT SYSTEM DATE AND TIME                        *DESBD200
00231 ******************************************************************DESBD200
00232  I2000-DATE-TIME.                                                 DESBD200
00233                                                                   DESBD200
00234      PERFORM S005-FROM-SYS          THRU S005-EXIT.               DESBD200
00235                                                                   DESBD200
00236      MOVE L005-DATE                TO WRK-CURR-DATE.              DESBD200
00237      MOVE L005-TIME                TO WRK-CURR-TIME.              DESBD200
00238      MOVE L005-ABSTIME             TO WRK-ABSTIME.                DESBD200
00239      MOVE L005-NINES-COMPLEMENT-ABSTIME                           DESBD200
00240                                    TO WRK-ABSTIME-XOR.            DESBD200
00241      MOVE L005-SLASH-DATE          TO WRK-DISP-DATE.              DESBD200
00242      MOVE L005-DISPLAY-TIME        TO WRK-DISP-TIME.              DESBD200
00243                                                                   DESBD200
00244  I2000-EXIT.                                                      DESBD200
00245      EXIT.                                                        DESBD200
00246                                                                   DESBD200
00247 ******************************************************************DESBD200
00248 *     INITIALIZE WRK-ERROR-TABLE                                 *DESBD200
00249 ******************************************************************DESBD200
00250  I3000-INIT-ERR-TAB.                                              DESBD200
00251                                                                   DESBD200
00252      SET EMSG101-SELECTED-NO      TO TRUE.                        DESBD200
00253      SET EMSG102-SELECTED-NO      TO TRUE.                        DESBD200
00254      SET EMSG103-SELECTED-NO      TO TRUE.                        DESBD200
00255      SET EMSG104-SELECTED-NO      TO TRUE.                        DESBD200
00256      SET EMSG105-SELECTED-NO      TO TRUE.                        DESBD200
00257      SET EMSG106-SELECTED-NO      TO TRUE.                        DESBD200
00258      SET EMSG107-SELECTED-NO      TO TRUE.                        DESBD200
00259      SET EMSG108-SELECTED-NO      TO TRUE.                        DESBD200
00260      SET EMSG109-SELECTED-NO      TO TRUE.                        DESBD200
00261      SET EMSG110-SELECTED-NO      TO TRUE.                        DESBD200
00262      SET EMSG111-SELECTED-NO      TO TRUE.                        DESBD200
00263      SET EMSG112-SELECTED-NO      TO TRUE.                        DESBD200
00264      SET EMSG113-SELECTED-NO      TO TRUE.                        DESBD200
00265      SET EMSG114-SELECTED-NO      TO TRUE.                        DESBD200
00266  I3000-EXIT.                                                      DESBD200
00267      EXIT.                                                        DESBD200
00268                                                                   DESBD200
00269                                                                   DESBD200
00270 ******************************************************************DESBD200
00271 *        GET THE LOG AND PROFILE RECORDS                         *DESBD200
00272 ******************************************************************DESBD200
00273  I4000-GET-LOG.                                                   DESBD200
00274                                                                   DESBD200
00275      MOVE ZERO TO WRK-LOG-NO.                                     DESBD200
00276                                                                   DESBD200
00277      IF L200-LOG-NO-SFX  NOT NUMERIC                              DESBD200
00278         DISPLAY '>>>  DESBD200 ABENDING   <<<'                    DESBD200
00279         DISPLAY '>>>  NON-NUMERIC LOG NUMBER ' L200-LOG-NO-SFX    DESBD200
00280         PERFORM S999-ABEND THRU S999-EXIT                         DESBD200
00281      ELSE                                                         DESBD200
00282         MOVE L200-LOG-NO-SFX           TO WRK-LOG-NO-SFX.         DESBD200
00283                                                                   DESBD200
00284      PERFORM S1000-READ-ELOG           THRU S1000-EXIT.           DESBD200
00285      IF WRK-FATAL-ERROR-YES                                       DESBD200
00286         DISPLAY '>>>  DESBD200 ABENDING   <<<'                    DESBD200
00287         DISPLAY '>>>  INVALID LOG NUMBER ' L200-LOG-NO            DESBD200
00288         PERFORM S999-ABEND THRU S999-EXIT.                        DESBD200
00289                                                                   DESBD200
00290      PERFORM S2000-READ-EPRF           THRU S2000-EXIT.           DESBD200
00291      IF WRK-FATAL-ERROR-YES                                       DESBD200
00292         DISPLAY '>>>  DESBD200 ABENDING   <<<'                    DESBD200
00293         DISPLAY '>>>  NO PROFILE RECORD ' L200-LOG-NO             DESBD200
00294         PERFORM S999-ABEND THRU S999-EXIT.                        DESBD200
00295                                                                   DESBD200
00296      MOVE WRK-LOG-NO                    TO L200-LOG-NO.           DESBD200
00297  I4000-EXIT.                                                      DESBD200
00298      EXIT.                                                        DESBD200
00299                                                                   DESBD200
00300 ******************************************************************DESBD200
00301 *        WRITE MESSAGE INDICATING THE JOB HAS BEGUN              *DESBD200
00302 ******************************************************************DESBD200
00303  P2000-WRITE-EMSG.                                                DESBD200
00304      MOVE LOW-VALUES                   TO EMSG-REC.               DESBD200
00305      SET EMSG-MSG-88                   TO TRUE.                   DESBD200
00306      MOVE ELOG-LOG-NO                  TO EMSG-LOG-NO.            DESBD200
00307      MOVE WRK-ABSTIME                  TO EMSG-ABSTIME.           DESBD200
00308      ADD 1                             TO WRK-EMSG-SEQ.           DESBD200
00309      MOVE WRK-EMSG-SEQ                 TO EMSG-SEQ.               DESBD200
00310                                                                   DESBD200
00311      SET EMSG-TYPE-STATUS-88           TO TRUE.                   DESBD200
00312      MOVE WRK-DISP-DATE                TO SMSG005-DATE.           DESBD200
00313      MOVE WRK-DISP-TIME                TO SMSG005-TIME.           DESBD200
00314      MOVE SMSG005-PROCESS-START-LONG   TO EMSG-FULL-MESSAGE.      DESBD200
00315      MOVE SMSG005-PROCESS-START-SHORT  TO EMSG-SHORT-MESSAGE.     DESBD200
00316      MOVE L200-PROG-NAME               TO EMSG-ESTB-OPID.         DESBD200
00317                                                                   DESBD200
00318      COMPUTE RSK4-LENGTH =                                        DESBD200
00319         (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EMSG-REC).       DESBD200
00320      MOVE ELOG-LOG-NO  TO RSK4-LOG-NO.                            DESBD200
00321      MOVE 'MSG'    TO RSK4-REC-TYPE.                              DESBD200
00322      MOVE EMSG-REC TO RSK4-REC-AREA.                              DESBD200
00323      PERFORM S946-TRN-REC-O THRU S946-EXIT.                       DESBD200
00324                                                                   DESBD200
00325  P2000-EXIT.                                                      DESBD200
00326      EXIT.                                                        DESBD200
00327                                                                   DESBD200
00328  P3000-EMP-COMPLETE.                                              DESBD200
00329      IF WRK-FATAL-ERROR-YES                                       DESBD200
00330        GO TO P3000-EXIT.                                          DESBD200
00331                                                                   DESBD200
00332      IF L200-EMP-NO = ZERO                                        DESBD200
00333        DISPLAY 'L200-EMP-NO = ZERO '                              DESBD200
00334        GO TO P3000-EXIT.                                          DESBD200
00335                                                                   DESBD200
00336      ADD L200-TOT-CNT           TO WRK-TOT-CNT.                   DESBD200
00337      ADD L200-SUCCESS-CNT       TO WRK-SUCCESS-CNT.               DESBD200
00338      ADD +1                     TO WRK-EMP-CNT.                   DESBD200
00339                                                                   DESBD200
00340      PERFORM P3100-BUILD-EEMH   THRU P3100-EXIT.                  DESBD200
00341      COMPUTE RSK4-LENGTH =                                        DESBD200
00342         (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EEMH-REC).       DESBD200
00343      MOVE ELOG-LOG-NO  TO RSK4-LOG-NO.                            DESBD200
00344      MOVE 'EMH'    TO RSK4-REC-TYPE.                              DESBD200
00345      MOVE EEMH-REC TO RSK4-REC-AREA.                              DESBD200
00346      PERFORM S946-TRN-REC-O THRU S946-EXIT.                       DESBD200
00347                                                                   DESBD200
00348      MOVE ZERO                  TO  L200-EMP-NO                   DESBD200
00349                                     L200-TOT-CNT                  DESBD200
00350                                     L200-SUCCESS-CNT.             DESBD200
00351                                                                   DESBD200
00352  P3000-EXIT.                                                      DESBD200
00353      EXIT.                                                        DESBD200
00354                                                                   DESBD200
00355  P3100-BUILD-EEMH.                                                DESBD200
00356      PERFORM P3110-DATE-TYPE  THRU P3110-EXIT.                    DESBD200
00357                                                                   DESBD200
00358      MOVE LOW-VALUES          TO EEMH-REC.                        DESBD200
00359                                                                   DESBD200
00360      SET EEMH-EMH-88          TO TRUE.                            DESBD200
00361      MOVE L200-EMP-NO         TO EEMH-EMP-NO                      DESBD200
00362                                  WRK-LAST-EMP-NO.                 DESBD200
00363      MOVE WRK-RPT-DATE        TO EEMH-REPORTING-DATE.             DESBD200
00364      MOVE ELOG-DATA-TYPE-CD   TO EEMH-DATA-TYPE-CD                DESBD200
00365      MOVE ELOG-LOG-NO         TO EEMH-LOG-NO.                     DESBD200
00366      MOVE LOW-VALUES          TO EEMH-KEY-FILLER.                 DESBD200
00367                                                                   DESBD200
00368      IF L200-SUCCESS-CNT = ZERO                                   DESBD200
00369         SET EEMH-RC-FAILED-88 TO TRUE                             DESBD200
00370      ELSE                                                         DESBD200
00371      IF L200-SUCCESS-CNT < L200-TOT-CNT                           DESBD200
00372         SET EEMH-RC-PART-SUCCESS-88 TO TRUE                       DESBD200
00373      ELSE                                                         DESBD200
00374         SET EEMH-RC-SUCCESSFUL-88 TO TRUE.                        DESBD200
00375                                                                   DESBD200
00376      MOVE ELOG-ELF-ID         TO EEMH-ELF-ID.                     DESBD200
00377      ADD 1                    TO WRK-EEMH-SEQ.                    DESBD200
00378      MOVE WRK-EEMH-SEQ        TO EEMH-EMP-SEQ-NO.                 DESBD200
00379      MOVE SPACES              TO EEMH-FILLER.                     DESBD200
00380                                                                   DESBD200
00381 *&                                                                DESBD200
00382      DISPLAY 'EEMH WRITTEN ' EEMH-EMP-NO.                         DESBD200
00383                                                                   DESBD200
00384  P3100-EXIT.                                                      DESBD200
00385      EXIT.                                                        DESBD200
00386                                                                   DESBD200
00387  P3110-DATE-TYPE.                                                 DESBD200
00388      MOVE SPACES     TO WRK-DATE-TYPE.                            DESBD200
00389                                                                   DESBD200
00390      PERFORM                                                      DESBD200
00391         VARYING C200-IDX FROM +1 BY +1                            DESBD200
00392         UNTIL C200-IDX > C200-TABLE-MAX                           DESBD200
00393            IF C200-PROG-NAME (C200-IDX) = L200-PROG-NAME          DESBD200
00394               MOVE C200-DATE-TYPE (C200-IDX) TO WRK-DATE-TYPE     DESBD200
00395            END-IF                                                 DESBD200
00396      END-PERFORM.                                                 DESBD200
00397                                                                   DESBD200
00398      IF WRK-DATE-TYPE = SPACES                                    DESBD200
00399         DISPLAY 'C200 TABLE ERROR'                                DESBD200
00400         MOVE WRK-CURR-DATE TO WRK-RPT-DATE                        DESBD200
00401         GO TO P3110-EXIT.                                         DESBD200
00402                                                                   DESBD200
00403      MOVE L200-REPORTING-DATE  TO WRK-RPT-DATE-IN.                DESBD200
00404                                                                   DESBD200
00405      IF WRK-DATE-TYPE = 'Q01'                                     DESBD200
00406         MOVE WRK-RPT-DATE-IN-5    TO L004-QTR-5-X                 DESBD200
00407         PERFORM S004-FROM-5  THRU S004-EXIT                       DESBD200
00408      ELSE                                                         DESBD200
00409      IF WRK-DATE-TYPE = 'Q02'                                     DESBD200
00410         MOVE WRK-RPT-DATE-IN-3    TO L004-QTR-3-X                 DESBD200
00411         PERFORM S004-FROM-3  THRU S004-EXIT.                      DESBD200
00412                                                                   DESBD200
00413      IF L004-VALID-QTR                                            DESBD200
00414         MOVE L004-QTR-END-DATE TO WRK-RPT-DATE                    DESBD200
00415      ELSE                                                         DESBD200
00416         DISPLAY 'INVALID QUARTER PASSED '                         DESBD200
00417            L200-REPORTING-DATE                                    DESBD200
00418         MOVE WRK-CURR-DATE TO WRK-RPT-DATE.                       DESBD200
00419  P3110-EXIT.                                                      DESBD200
00420      EXIT.                                                        DESBD200
00421                                                                   DESBD200
00422                                                                   DESBD200
00423  T0000-TERMINATE.                                                 DESBD200
00424      IF L200-EMP-NO NOT = ZERO                                    DESBD200
00425         PERFORM P3000-EMP-COMPLETE      THRU P3000-EXIT           DESBD200
00426      END-IF.                                                      DESBD200
00427                                                                   DESBD200
00428      IF WRK-FATAL-ERROR-NO                                        DESBD200
00429         PERFORM T1000-BUILD-ERR-MSG     THRU T1000-EXIT           DESBD200
00430         PERFORM T2000-BUILD-SUM-MSG     THRU T2000-EXIT           DESBD200
00431                                                                   DESBD200
00432      PERFORM T4000-CLOSE-FILES   THRU T4000-EXIT.                 DESBD200
00433                                                                   DESBD200
00434  T0000-EXIT.                                                      DESBD200
00435      EXIT.                                                        DESBD200
00436      EJECT                                                        DESBD200
00437                                                                   DESBD200
00438  T1000-BUILD-ERR-MSG.                                             DESBD200
00439      IF EMSG101-SELECTED-YES                                      DESBD200
00440         MOVE EMSG101-INV-QTR-CD       TO WRK-ERR-MESSAGE          DESBD200
00441         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00442      END-IF.                                                      DESBD200
00443                                                                   DESBD200
00444      IF EMSG102-SELECTED-YES                                      DESBD200
00445         MOVE EMSG102-NONE-NUM-YR      TO WRK-ERR-MESSAGE          DESBD200
00446         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00447      END-IF.                                                      DESBD200
00448                                                                   DESBD200
00449      IF EMSG103-SELECTED-YES                                      DESBD200
00450         MOVE EMSG103-NO-MATCH-PROC-YR TO WRK-ERR-MESSAGE          DESBD200
00451         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00452      END-IF.                                                      DESBD200
00453                                                                   DESBD200
00454      IF EMSG104-SELECTED-YES                                      DESBD200
00455         MOVE EMSG104-NONE-NUM-SSN     TO WRK-ERR-MESSAGE          DESBD200
00456         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00457      END-IF.                                                      DESBD200
00458                                                                   DESBD200
00459      IF EMSG105-SELECTED-YES                                      DESBD200
00460         MOVE EMSG105-NONE-NUM-EARN    TO WRK-ERR-MESSAGE          DESBD200
00461         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00462      END-IF.                                                      DESBD200
00463                                                                   DESBD200
00464      IF EMSG106-SELECTED-YES                                      DESBD200
00465         MOVE EMSG106-ZERO-EARN        TO WRK-ERR-MESSAGE          DESBD200
00466         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00467      END-IF.                                                      DESBD200
00468                                                                   DESBD200
00469      IF EMSG107-SELECTED-YES                                      DESBD200
00470         MOVE EMSG107-NAME-MISSING     TO WRK-ERR-MESSAGE          DESBD200
00471         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00472      END-IF.                                                      DESBD200
00473                                                                   DESBD200
00474      IF EMSG108-SELECTED-YES                                      DESBD200
00475         MOVE EMSG108-NONE-NUM-ACCT    TO WRK-ERR-MESSAGE          DESBD200
00476         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00477      END-IF.                                                      DESBD200
00478                                                                   DESBD200
00479      IF EMSG109-SELECTED-YES                                      DESBD200
00480         MOVE EMSG109-INV-EMPL-ACCT    TO WRK-ERR-MESSAGE          DESBD200
00481         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00482      END-IF.                                                      DESBD200
00483                                                                   DESBD200
00484      IF EMSG110-SELECTED-YES                                      DESBD200
00485         MOVE EMSG110-EMPL-NAME-SPACE  TO WRK-ERR-MESSAGE          DESBD200
00486         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00487      END-IF.                                                      DESBD200
00488                                                                   DESBD200
00489      IF EMSG111-SELECTED-YES                                      DESBD200
00490         MOVE EMSG111-NAME-CHECK-BLANK TO WRK-ERR-MESSAGE          DESBD200
00491         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00492      END-IF.                                                      DESBD200
00493                                                                   DESBD200
00494      IF EMSG112-SELECTED-YES                                      DESBD200
00495         MOVE EMSG112-NONE-NUM-TRAN-ID TO WRK-ERR-MESSAGE          DESBD200
00496         PERFORM T1100-WRITE-ERROR     THRU T1100-EXIT             DESBD200
00497      END-IF.                                                      DESBD200
00498                                                                   DESBD200
00499      IF EMSG113-SELECTED-YES                                      DESBD200
00500         MOVE EMSG113-NONE-NUM-TRAN-DATE TO WRK-ERR-MESSAGE        DESBD200
00501         PERFORM T1100-WRITE-ERROR       THRU T1100-EXIT           DESBD200
00502      END-IF.                                                      DESBD200
00503                                                                   DESBD200
00504      IF EMSG114-SELECTED-YES                                      DESBD200
00505         MOVE EMSG114-NONE-NUM-TRAN-TIME TO WRK-ERR-MESSAGE        DESBD200
00506         PERFORM T1100-WRITE-ERROR       THRU T1100-EXIT           DESBD200
00507      END-IF.                                                      DESBD200
00508                                                                   DESBD200
00509  T1000-EXIT.                                                      DESBD200
00510      EXIT.                                                        DESBD200
00511                                                                   DESBD200
00512  T1100-WRITE-ERROR.                                               DESBD200
00513      MOVE LOW-VALUES         TO ESKL-KEY-AREA.                    DESBD200
00514      SET EMSG-MSG-88         TO TRUE.                             DESBD200
00515      MOVE ELOG-LOG-NO        TO EMSG-LOG-NO.                      DESBD200
00516      MOVE WRK-ABSTIME        TO EMSG-ABSTIME.                     DESBD200
00517      ADD 1 TO WRK-EMSG-SEQ.                                       DESBD200
00518      MOVE WRK-EMSG-SEQ       TO EMSG-SEQ.                         DESBD200
00519                                                                   DESBD200
00520      SET EMSG-TYPE-ERROR-88  TO TRUE.                             DESBD200
00521      MOVE WRK-ERR-MESSAGE    TO EMSG-FULL-MESSAGE.                DESBD200
00522      MOVE SPACES             TO EMSG-SHORT-MESSAGE.               DESBD200
00523      MOVE SPACES             TO EMSG-FILLER.                      DESBD200
00524      MOVE L200-PROG-NAME     TO EMSG-ESTB-OPID.                   DESBD200
00525                                                                   DESBD200
00526      COMPUTE RSK4-LENGTH =                                        DESBD200
00527         (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EMSG-REC).       DESBD200
00528      MOVE ELOG-LOG-NO  TO RSK4-LOG-NO.                            DESBD200
00529      MOVE 'MSG'    TO RSK4-REC-TYPE.                              DESBD200
00530      MOVE EMSG-REC TO RSK4-REC-AREA.                              DESBD200
00531      PERFORM S946-TRN-REC-O THRU S946-EXIT.                       DESBD200
00532                                                                   DESBD200
00533      DISPLAY 'ERROR WRITTEN ' WRK-ERR-MESSAGE.                    DESBD200
00534  T1100-EXIT.                                                      DESBD200
00535      EXIT.                                                        DESBD200
00536                                                                   DESBD200
00537  T2000-BUILD-SUM-MSG.                                             DESBD200
00538      MOVE LOW-VALUES           TO ESKL-KEY-AREA.                  DESBD200
00539      SET EMSG-MSG-88           TO TRUE.                           DESBD200
00540      MOVE ELOG-LOG-NO          TO EMSG-LOG-NO.                    DESBD200
00541      MOVE WRK-ABSTIME          TO EMSG-ABSTIME.                   DESBD200
00542      ADD 1                     TO WRK-EMSG-SEQ.                   DESBD200
00543      MOVE WRK-EMSG-SEQ         TO EMSG-SEQ.                       DESBD200
00544                                                                   DESBD200
00545      SET EMSG-TYPE-SUMMARY-88  TO TRUE.                           DESBD200
00546      MOVE WRK-TOT-CNT          TO EMSG100-TOT-CNT.                DESBD200
00547      MOVE WRK-SUCCESS-CNT      TO EMSG100-SUCCESS-CNT.            DESBD200
00548      MOVE EMSG100-WAGE-SUMMARY TO EMSG-FULL-MESSAGE.              DESBD200
00549                                                                   DESBD200
00550      IF WRK-SUCCESS-CNT = ZERO                                    DESBD200
00551         MOVE 'FAILED'          TO EMSG-SHORT-MESSAGE              DESBD200
00552      ELSE                                                         DESBD200
00553      IF WRK-SUCCESS-CNT < WRK-TOT-CNT                             DESBD200
00554         MOVE 'PART SUCCESS'    TO EMSG-SHORT-MESSAGE              DESBD200
00555      ELSE                                                         DESBD200
00556         MOVE 'SUCCESSFUL'      TO EMSG-SHORT-MESSAGE.             DESBD200
00557                                                                   DESBD200
00558      MOVE SPACES               TO EMSG-FILLER.                    DESBD200
00559                                                                   DESBD200
00560      MOVE L200-PROG-NAME       TO EMSG-ESTB-OPID.                 DESBD200
00561                                                                   DESBD200
00562      COMPUTE RSK4-LENGTH =                                        DESBD200
00563         (LENGTH OF RSK4-CONTROL-AREA + LENGTH OF EMSG-REC).       DESBD200
00564      MOVE ELOG-LOG-NO  TO RSK4-LOG-NO.                            DESBD200
00565      MOVE 'MSG'    TO RSK4-REC-TYPE.                              DESBD200
00566      MOVE EMSG-REC TO RSK4-REC-AREA.                              DESBD200
00567      PERFORM S946-TRN-REC-O    THRU S946-EXIT.                    DESBD200
00568                                                                   DESBD200
00569                                                                   DESBD200
00570      DISPLAY 'SUMMARY MESSAGE ' EMSG100-WAGE-SUMMARY.             DESBD200
00571  T2000-EXIT.                                                      DESBD200
00572      EXIT.                                                        DESBD200
00573                                                                   DESBD200
00574 ******************************************************************DESBD200
00575 *           WHEN PROCESS IS COMPLETED SET L222-END-UPDATE        *DESBD200
00576 *           TO TRUE AND CALL DTSBU222 TO UN-LOCK THE EPRF.       *DESBD200
00577 ******************************************************************DESBD200
00578  T4000-CLOSE-FILES.                                               DESBD200
00579                                                                   DESBD200
00580      PERFORM S921-CLOSE       THRU S921-EXIT.                     DESBD200
00581      PERFORM S935-CLOSE       THRU S935-EXIT.                     DESBD200
00582                                                                   DESBD200
00583      DISPLAY '*** DESBD200 TERMINATION STATISTICS '               DESBD200
00584                                                                   DESBD200
00585      MOVE -1 TO RSK4-LENGTH.                                      DESBD200
00586                                                                   DESBD200
00587      PERFORM S946-TRN-REC-O THRU S946-EXIT.                       DESBD200
00588                                                                   DESBD200
00589  T4000-EXIT.                                                      DESBD200
00590      EXIT.                                                        DESBD200
00591                                                                   DESBD200
00592  S004-FROM-5.                                                     DESBD200
00593      SET L004-FROM-5   TO TRUE.                                   DESBD200
00594      GO TO S004-YRQ.                                              DESBD200
00595                                                                   DESBD200
00596  S004-FROM-3.                                                     DESBD200
00597      SET L004-FROM-3   TO TRUE.                                   DESBD200
00598      GO TO S004-YRQ.                                              DESBD200
00599                                                                   DESBD200
00600  S004-YRQ.                                                        DESBD200
00601      CALL 'DTSBU004' USING L004-LINK-AREA.                        DESBD200
00602                                                                   DESBD200
00603  S004-EXIT.                                                       DESBD200
00604      EXIT.                                                        DESBD200
00605                                                                   DESBD200
00606  S005-FROM-SYS.                                                   DESBD200
00607      SET L005-FROM-SYS TO TRUE.                                   DESBD200
00608      GO TO S005-ABSTIME.                                          DESBD200
00609                                                                   DESBD200
00610  S005-ABSTIME.                                                    DESBD200
00611      CALL 'DTSBU005' USING L005-LINK-AREA.                        DESBD200
00612                                                                   DESBD200
00613  S005-EXIT.                                                       DESBD200
00614      EXIT.                                                        DESBD200
00615                                                                   DESBD200
00616  S921-OPEN-READ.                                                  DESBD200
00617      SET L921-OPEN-READ-88    TO TRUE.                            DESBD200
00618      GO TO S921-AIX-IO.                                           DESBD200
00619                                                                   DESBD200
00620  S921-READ.                                                       DESBD200
00621      SET L921-READ-88         TO TRUE.                            DESBD200
00622      GO TO S921-AIX-IO.                                           DESBD200
00623                                                                   DESBD200
00624  S921-START-BROWSE.                                               DESBD200
00625      SET L921-START-BROWSE-88 TO TRUE.                            DESBD200
00626      GO TO S921-AIX-IO.                                           DESBD200
00627                                                                   DESBD200
00628  S921-READ-NEXT.                                                  DESBD200
00629      SET L921-READ-NEXT-88    TO TRUE.                            DESBD200
00630      GO TO S921-AIX-IO.                                           DESBD200
00631                                                                   DESBD200
00632  S921-CLOSE.                                                      DESBD200
00633      SET L921-CLOSE-88        TO TRUE.                            DESBD200
00634      GO TO S921-AIX-IO.                                           DESBD200
00635                                                                   DESBD200
00636  S921-AIX-IO.                                                     DESBD200
00637      CALL 'DTSBU921' USING L921-LINK-AREA                         DESBD200
00638                            ISKL-REC.                              DESBD200
00639  S921-EXIT.                                                       DESBD200
00640      EXIT.                                                        DESBD200
00641      SKIP3                                                        DESBD200
00642                                                                   DESBD200
00643  S935-OPEN-READ.                                                  DESBD200
00644      SET L935-OPEN-READ-88 TO TRUE.                               DESBD200
00645      GO TO S935-ELF-IO.                                           DESBD200
00646                                                                   DESBD200
00647  S935-READ.                                                       DESBD200
00648      SET L935-READ-88 TO TRUE.                                    DESBD200
00649      GO TO S935-ELF-IO.                                           DESBD200
00650                                                                   DESBD200
00651  S935-START-BROWSE.                                               DESBD200
00652      SET L935-START-BROWSE-88 TO TRUE.                            DESBD200
00653      GO TO S935-ELF-IO.                                           DESBD200
00654                                                                   DESBD200
00655  S935-READ-NEXT.                                                  DESBD200
00656      SET L935-READ-NEXT-88 TO TRUE.                               DESBD200
00657      GO TO S935-ELF-IO.                                           DESBD200
00658                                                                   DESBD200
00659  S935-CLOSE.                                                      DESBD200
00660      SET L935-CLOSE-88        TO TRUE.                            DESBD200
00661      GO TO S935-ELF-IO.                                           DESBD200
00662                                                                   DESBD200
00663  S935-ELF-IO.                                                     DESBD200
00664      CALL 'DTSBU935' USING L935-LINK-AREA                         DESBD200
00665                            ESKL-REC.                              DESBD200
00666  S935-EXIT.                                                       DESBD200
00667      EXIT.                                                        DESBD200
00668      SKIP3                                                        DESBD200
00669                                                                   DESBD200
00670  S946-TRN-REC-O.                                                  DESBD200
00671      CALL 'DTSBU946' USING RSK4-REC.                              DESBD200
00672  S946-EXIT.                                                       DESBD200
00673      EXIT.                                                        DESBD200
00674                                                                   DESBD200
00675  S1000-READ-ELOG.                                                 DESBD200
00676      MOVE LOW-VALUES        TO IEAL-KEY-AREA                      DESBD200
00677      SET IEAL-EAL-88        TO TRUE                               DESBD200
00678      MOVE WRK-LOG-NO-SFX    TO IEAL-LOG-NO-SFX                    DESBD200
00679      MOVE ZEROS             TO IEAL-LOG-NO                        DESBD200
00680      MOVE IEAL-REC          TO ISKL-REC.                          DESBD200
00681      PERFORM S921-START-BROWSE THRU S921-EXIT.                    DESBD200
00682      IF L921-OK-88                                                DESBD200
00683         MOVE ISKL-REC       TO IEAL-REC                           DESBD200
00684         IF IEAL-LOG-NO-SFX = WRK-LOG-NO-SFX                       DESBD200
00685            MOVE IEAL-LOG-NO TO WRK-LOG-NO                         DESBD200
00686         ELSE                                                      DESBD200
00687            DISPLAY 'INVALID READ L200-LOG-NO:  ' L200-LOG-NO      DESBD200
00688            SET WRK-FATAL-ERROR-YES        TO TRUE                 DESBD200
00689            GO TO S1000-EXIT                                       DESBD200
00690      ELSE                                                         DESBD200
00691         DISPLAY 'INVALID READ L200-LOG-NO:  ' L200-LOG-NO         DESBD200
00692         SET WRK-FATAL-ERROR-YES        TO TRUE                    DESBD200
00693         GO TO S1000-EXIT.                                         DESBD200
00694                                                                   DESBD200
00695      MOVE LOW-VALUES                   TO ELOG-REC.               DESBD200
00696      MOVE WRK-LOG-NO                   TO ELOG-LOG-NO.            DESBD200
00697      SET ELOG-LOG-88                   TO TRUE.                   DESBD200
00698      MOVE ELOG-KEY-AREA                TO ESKL-KEY-AREA.          DESBD200
00699                                                                   DESBD200
00700      PERFORM S935-READ                 THRU S935-EXIT.            DESBD200
00701                                                                   DESBD200
00702      IF L935-NO-REC-88                                            DESBD200
00703         DISPLAY 'INVALID READ L200-LOG-NO:  ' L200-LOG-NO         DESBD200
00704         SET WRK-FATAL-ERROR-YES        TO TRUE                    DESBD200
00705      ELSE                                                         DESBD200
00706         MOVE ESKL-REC                  TO ELOG-REC                DESBD200
00707      END-IF.                                                      DESBD200
00708                                                                   DESBD200
00709      DISPLAY 'BD200 S1000 WRK LOG NO ' WRK-LOG-NO.                DESBD200
00710  S1000-EXIT.                                                      DESBD200
00711      EXIT.                                                        DESBD200
00712                                                                   DESBD200
00713  S2000-READ-EPRF.                                                 DESBD200
00714                                                                   DESBD200
00715      MOVE LOW-VALUES                   TO EPRF-REC.               DESBD200
00716      MOVE ELOG-ELF-ID                  TO EPRF-ELF-ID.            DESBD200
00717      MOVE ELOG-DATA-TYPE-CD            TO EPRF-DATA-TYPE-CD.      DESBD200
00718      SET EPRF-PRF-88                   TO TRUE.                   DESBD200
00719      MOVE EPRF-KEY-AREA                TO ESKL-KEY-AREA.          DESBD200
00720                                                                   DESBD200
00721      PERFORM S935-READ                 THRU S935-EXIT.            DESBD200
00722                                                                   DESBD200
00723      IF L935-NO-REC-88                                            DESBD200
00724         DISPLAY 'NO EPRF REC FOUND ON READ USING ELOG-ELF-ID = '  DESBD200
00725                    ELOG-ELF-ID                                    DESBD200
00726         DISPLAY 'ELOG DATA TYPE IS: ' ELOG-DATA-TYPE-CD           DESBD200
00727         SET WRK-FATAL-ERROR-YES        TO TRUE                    DESBD200
00728      ELSE                                                         DESBD200
00729         MOVE ESKL-REC                  TO EPRF-REC                DESBD200
00730      END-IF.                                                      DESBD200
00731                                                                   DESBD200
00732      IF EPRF-BATCH-UPD-ACTIVE-88                                  DESBD200
00733         NEXT SENTENCE                                             DESBD200
00734      ELSE                                                         DESBD200
00735        IF EPRF-CICS-UPD-ACTIVE-88                                 DESBD200
00736           MOVE 'CICS UPDATE IS ACTIVE ' TO WRK-ABEND-MSG          DESBD200
00737           PERFORM S999-ABEND THRU S999-EXIT                       DESBD200
00738        END-IF                                                     DESBD200
00739      END-IF.                                                      DESBD200
00740                                                                   DESBD200
00741  S2000-EXIT.                                                      DESBD200
00742      EXIT.                                                        DESBD200
00743                                                                   DESBD200
00744  S999-ABEND.                                                      DESBD200
00745      DISPLAY '**** DESBD200 ABENDING ' WRK-ABEND-MSG.             DESBD200
00746      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DESBD200
00747  S999-EXIT.                                                       DESBD200
00748      EXIT.                                                        DESBD200
00749                                                                   DESBD200
