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