00001  IDENTIFICATION DIVISION.                                         04/22/03
00002  PROGRAM-ID.             EFTBD400.                                EFTBD400
00003  AUTHOR.                 TRW.                                        LV003
00004  DATE-WRITTEN.           APRIL 2003.                                 CL**2
00005  DATE-COMPILED.                                                   EFTBD400
00006      SKIP3                                                        EFTBD400
00007 *****                                                             EFTBD400
00008 *                                                                 EFTBD400
00009 *    FUNCTION:  PERIODIC REPORT EXTRACT - EFT VERSION                CL**2
00010 *                                                                 EFTBD400
00011 *                                                                 EFTBD400
00012 *    MODIFICATION LOG:                                            EFTBD400
00013 *                                                                 EFTBD400
00014 *    12/31/91  INITIAL DEVELOPMENT.                               EFTBD400
00015 *              WORK ORDER:                      PROGRAMMER: TCL   EFTBD400
00016 *                                                                 EFTBD400
00017 *    10/05/1998  REVIEWED AND MODIFIED FOR DC.                    EFTBD400
00018 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   EFTBD400
00019 *                                                                 EFTBD400
00020 *    05/24/1999  INITIALIZE LECM-PICKUP-DIR.                      EFTBD400
00021 *                REFERENCE: PICKUP DIR          PROGRAMMER: EHH   EFTBD400
00022 *                                                                 EFTBD400
00023 *    04/21/2003  MODIFIED FROM DTSBD400                              CL**2
00024 *                REFERENCE: EFT                 PROGRAMMER: GD       CL**2
00025 *                                                                    CL**2
00026 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   EFTBD400
00027 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   EFTBD400
00028 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   EFTBD400
00029 *                                                                 EFTBD400
00030 *                                                                 EFTBD400
00031 *  DESCRIPTION:                                                   EFTBD400
00032 *                                                                 EFTBD400
00033 *    INITIATION.                                                  EFTBD400
00034 *                                                                 EFTBD400
00035 *      PROCESS PARAMETERS INPUT VIA LINKAGE (IN PARM-AREA).       EFTBD400
00036 *                                                                 EFTBD400
00037 *                                                                 EFTBD400
00038 *      READ THE PARM-FILE UNTIL PARM-EOF.  ONE TO FIFTY PARM      EFTBD400
00039 *      RECORD WILL BE INPUT.                                      EFTBD400
00040 *                                                                 EFTBD400
00041 *      DISPLAY EACH PARM RECORD.                                  EFTBD400
00042 *                                                                 EFTBD400
00043 *      EACH PARM RECORD INDICATES AN EXTRACT MODULE TO BE CALLED  EFTBD400
00044 *      DURING THIS PARTICULAR RUN, AND CONTAINS ANY EXTRACT       EFTBD400
00045 *      MODULE SPECIFIC PARAMETERS.                                EFTBD400
00046 *                                                                 EFTBD400
00047 *      TABLE PARM RECORDS 1 THRU N IN WRK-EXTRACT-AREA.           EFTBD400
00048 *                                                                 EFTBD400
00049 *      THE SAME WRK-EXTRACT-ID VALUE IN MULTIPLE OCCURRENCES OF   EFTBD400
00050 *      WRK-EXTRACT-AREA IS NOT ALLOWED.  IF THIS CONDITION        EFTBD400
00051 *      OCCURS, THEN ABEND THE MODULE.                             EFTBD400
00052 *                                                                 EFTBD400
00053 *      MAKE AN 'INITIALIZATION' CALL TO EACH OF THE EXTRACT       EFTBD400
00054 *      MODULES TABLED IN WRK-EXTRACT-AREA.  SAVE THE HIGHEST      EFTBD400
00055 *      VALUE RETURNED IN LECM-OPEN-MST-IND AND SAVE THE           EFTBD400
00056 *      HIGHEST VALUE RETURNED IN LECM-OPEN-REF-IND.               EFTBD400
00057 *                                                                 EFTBD400
00058 *      OPEN THE MASTER FILE, ALTERNATE INDEX FILE AND             EFTBD400
00059 *      REFERENCE FILE WITH THE OPEN COMMAND (READ ONLY            EFTBD400
00060 *      OR UPDATE) AS INDICATED BY THE INFORMATION RETURNED        EFTBD400
00061 *      BY THE "INITIALIZATION" CALLS.                             EFTBD400
00062 *                                                                 EFTBD400
00063 *                                                                 EFTBD400
00064 *      READ THE MHDR RECORD.                                      EFTBD400
00065 *                                                                 EFTBD400
00066 *      IF L910-NO-REC-88                                          EFTBD400
00067 *          ABEND THE MODULE.                                      EFTBD400
00068 *                                                                 EFTBD400
00069 *      INITIALIZE THE LECM FIELDS.                                EFTBD400
00070 *                                                                 EFTBD400
00071 *      SET LECM-PROCESS-88 TO TRUE.                               EFTBD400
00072 *                                                                 EFTBD400
00073 *      SET L910 TO "READ NEXT" A MPRF RECORD.                     EFTBD400
00074 *                                                                 EFTBD400
00075 *      MOVE +0 TO WRK-MPRF-CNT.                                   EFTBD400
00076 *                                                                 EFTBD400
00077 *                                                                 EFTBD400
00078 *                                                                 EFTBD400
00079 *    PROCESSING.                                                  EFTBD400
00080 *                                                                 EFTBD400
00081 *          PERFORM P1000-READ-NEXT                                EFTBD400
00082 *              UNTIL L910-NO-REC-88.                              EFTBD400
00083 *                                                                 EFTBD400
00084 *      P1000-READ-NEXT.                                           EFTBD400
00085 *          READ THE NEXT MPRF RECORD.                             EFTBD400
00086 *          IF L910-OK-88                                          EFTBD400
00087 *              ADD +1 TO WRK-MPRF-CNT                             EFTBD400
00088 *              PERFORM S1000-CALL-EXTRACT                         EFTBD400
00089 *                  VARYING WRK-EXT-IDX FROM 1 BY 1                EFTBD400
00090 *                  UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.           EFTBD400
00091 *                                                                 EFTBD400
00092 *      S1000-CALL-EXTRACT.                                        EFTBD400
00093 *          MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX)                   EFTBD400
00094 *            TO LECM-EXTRACT-PARMS.                               EFTBD400
00095 *                                                                 EFTBD400
00096 *            CALL 'EFTBX***' USING LECM-LINK-AREA                    CL**3
00097 *                                  MPRF-REC.                      EFTBD400
00098 *                                                                 EFTBD400
00099 *          IF NO EXTRACT MODULE CORRESPONDING TO WRK-EXTRACT-SUB  EFTBD400
00100 *          EXISTS, THEN THE STEP ABENDS (MODULE NOT FOUND).       EFTBD400
00101 *                                                                 EFTBD400
00102 *                                                                 EFTBD400
00103 *                                                                 EFTBD400
00104 *    TERMINATION.                                                 EFTBD400
00105 *                                                                 EFTBD400
00106 *      SET LECM-TERMINATE-88 TO TRUE.                             EFTBD400
00107 *                                                                 EFTBD400
00108 *      PERFORM S1000-CALL-EXTRACT                                 EFTBD400
00109 *          VARYING WRK-EXT-IDX FROM 1 BY 1                        EFTBD400
00110 *          UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                   EFTBD400
00111 *                                                                 EFTBD400
00112 *      DISPLAY TERMINATION STATISTICS (VARIOUS LECM FIELDS AND    EFTBD400
00113 *      WRK-MPRF-CNT.                                              EFTBD400
00114 *                                                                 EFTBD400
00115 *      CLOSE MASTER FILE.                                         EFTBD400
00116 *      CLOSE ALTERNATE INDEX FILE.                                EFTBD400
00117 *      CLOSE REFERENCE FILE.                                      EFTBD400
00118 *      CLOSE REPORT RECORD FILE.                                  EFTBD400
00119 *                                                                 EFTBD400
00120 *      SET RETURN-CODE TO 0.                                      EFTBD400
00121 *                                                                 EFTBD400
00122 *****                                                             EFTBD400
00123      SKIP3                                                        EFTBD400
00124  ENVIRONMENT DIVISION.                                            EFTBD400
00125      SKIP2                                                        EFTBD400
00126  INPUT-OUTPUT SECTION.                                            EFTBD400
00127                                                                   EFTBD400
00128  FILE-CONTROL.                                                    EFTBD400
00129      SELECT PARM-FILE ASSIGN TO SYSIN.                            EFTBD400
00130      EJECT                                                        EFTBD400
00131  DATA DIVISION.                                                   EFTBD400
00132      SKIP3                                                        EFTBD400
00133  FILE SECTION.                                                    EFTBD400
00134      SKIP2                                                        EFTBD400
00135  FD  PARM-FILE                                                    EFTBD400
00136      RECORDING MODE IS F                                          EFTBD400
00137      BLOCK CONTAINS 0 RECORDS.                                    EFTBD400
00138                                                                   EFTBD400
00139  01  PARM-REC.                                                    EFTBD400
00140          10  PREC-EXTRACT-ID             PIC  X(03).              EFTBD400
00141          10  FILLER                      PIC  X(01).              EFTBD400
00142          10  PREC-EXTRACT-PARMS          PIC  X(68).              EFTBD400
00143          10  FILLER                      PIC  X(08).              EFTBD400
00144      EJECT                                                        EFTBD400
00145  WORKING-STORAGE SECTION.                                         EFTBD400
001455 77  PAN-VALET PICTURE X(24) VALUE '003EFTBD400  04/22/03'.       EFTBD400
00146      SKIP3                                                        EFTBD400
00147  01  WRK-AREA.                                                    EFTBD400
00148      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +400.EFTBD400
00149                                                                   EFTBD400
00150      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'EFTBD400'.   CL**2
00151                                                                   EFTBD400
00152      05  WRK-MPRF-CNT                PIC S9(07)  COMP-3.          EFTBD400
00153                                                                   EFTBD400
00154      05  WRK-UPDATED-CNT             PIC S9(07)  COMP-3.          EFTBD400
00155                                                                   EFTBD400
00156      05  PARM-REC-CNT                PIC S9(07)  COMP-3.          EFTBD400
00157                                                                   EFTBD400
00158      05  HOLD-EXTRACT-SUB            PIC S9(04)  COMP.            EFTBD400
00159                                                                   EFTBD400
00160      05  WRK-SUB                     PIC S9(04)  COMP.            EFTBD400
00161                                                                   EFTBD400
00162      05  PARM-EOF-IND                    PIC  X(01).              EFTBD400
00163                                                                   EFTBD400
00164      05  WRK-RUN-TYPE                    PIC  X(02).              EFTBD400
00165                                                                   EFTBD400
00166      05  WRK-PRE-BACKUP-IND              PIC  X(01).              EFTBD400
00167                                                                   EFTBD400
00168      05  WRK-ONLY-CHECK-PARM-IND         PIC  X(01).              EFTBD400
00169                                                                   EFTBD400
00170      05  WRK-TRACE-IND                   PIC  X(01).              EFTBD400
00171                                                                   EFTBD400
00172      05  WRK-MST-OPEN-IND                PIC  X(01).              EFTBD400
00173                                                                   EFTBD400
00174      05  WRK-REF-OPEN-IND                PIC  X(01).              EFTBD400
00175                                                                   EFTBD400
00176 *****05  WRK-BTC-IND                     PIC  X(01).              EFTBD400
00177                                                                   EFTBD400
00178      05  WRK-EMP-UPDATED-IND             PIC  X(01).              EFTBD400
00179          88  WRK-EMP-UPDATED-NO-88              VALUE 'N'.        EFTBD400
00180          88  WRK-EMP-UPDATED-YES-88             VALUE 'Y'.        EFTBD400
00181      SKIP3                                                        EFTBD400
00182      05  WRK-EXTRACT-CNT                 PIC S9(04)       COMP.   EFTBD400
00183                                                                   EFTBD400
00184      05  WRK-EXTRACT-AREA OCCURS 50 TIMES                         EFTBD400
00185                           INDEXED BY WRK-EXT-IDX.                 EFTBD400
00186          10  WRK-EXTRACT-ID              PIC  X(03).              EFTBD400
00187          10  WRK-EXTRACT-PARMS           PIC  X(68).              EFTBD400
00188      SKIP3                                                        EFTBD400
00189      05  WRK-START-ABSTIME               PIC S9(15)       COMP-3. EFTBD400
00190                                                                   EFTBD400
00191      05  WRK-STEP-DURATION-X             PIC  X(09).              EFTBD400
00192      05  WRK-STEP-DURATION REDEFINES WRK-STEP-DURATION-X          EFTBD400
00193                                          PIC  ZZ,ZZ9.99.          EFTBD400
00194      SKIP3                                                        EFTBD400
00195      05  EXTRACT-MOD-NAME.                                        EFTBD400
00196          10  FILLER                  PIC  X(05)  VALUE 'EFTBX'.      CL**3
00197          10  EXTRACT-MOD-ID          PIC  X(03).                  EFTBD400
00198      EJECT                                                        EFTBD400
00199  01  MSG-TABLE.                                                   EFTBD400
00200      05  MSG1-UPDATE-LOCKED-EMP.                                  EFTBD400
00201          10  MSG1-ID                 PIC  X(03)  VALUE '991'.     EFTBD400
00202          10  MSG1-TEXT.                                           EFTBD400
00203              15  FILLER              PIC  X(30)                   EFTBD400
00204                    VALUE 'DESPITE BEING LOCKED AGAINST U'.        EFTBD400
00205              15  FILLER              PIC  X(30)                   EFTBD400
00206                    VALUE 'PDATE, A PERIODIC EXTRACT PROC'.        EFTBD400
00207              15  FILLER              PIC  X(05)                   EFTBD400
00208                    VALUE 'ESS ('.                                 EFTBD400
00209              15  MSG1-EXTRACT-ID     PIC  X(03).                  EFTBD400
00210              15  FILLER              PIC  X(31)                   EFTBD400
00211                    VALUE ') UPDATED THE EMPLOYERS RECORDS'.       EFTBD400
00212      EJECT                                                        EFTBD400
00213  01  LECM-LINK-AREA.                                              EFTBD400
00214  ++INCLUDE DTSILECM                                               EFTBD400
00215      EJECT                                                        EFTBD400
00216  01  L910-LINK-AREA.                                              EFTBD400
00217  ++INCLUDE DTSIL910                                               EFTBD400
00218      EJECT                                                        EFTBD400
00219  01  MSKL-REC.                                                    EFTBD400
00220  ++INCLUDE DTSIMSKL                                               EFTBD400
00221      EJECT                                                        EFTBD400
00222  01  MHDR-REC REDEFINES MSKL-REC.                                 EFTBD400
00223  ++INCLUDE DTSIMHDR                                               EFTBD400
00224      EJECT                                                        EFTBD400
00225  01  MPRF-REC REDEFINES MSKL-REC.                                 EFTBD400
00226  ++INCLUDE DTSIMPRF                                               EFTBD400
00227      EJECT                                                        EFTBD400
00228  01  L921-LINK-AREA.                                              EFTBD400
00229  ++INCLUDE DTSIL921                                               EFTBD400
00230      EJECT                                                        EFTBD400
00231  01  ISKL-REC.                                                    EFTBD400
00232  ++INCLUDE DTSIISKL                                               EFTBD400
00233      EJECT                                                        EFTBD400
00234  01  L927-LINK-AREA.                                              EFTBD400
00235  ++INCLUDE DTSIL927                                               EFTBD400
00236      EJECT                                                        EFTBD400
00237  01  RSKL-REC.                                                    EFTBD400
00238  ++INCLUDE DTSIRSK1                                               EFTBD400
00239      SKIP3                                                        EFTBD400
00240  01  R907-REC.                                                    EFTBD400
00241  ++INCLUDE DTSIR907                                               EFTBD400
00242      EJECT                                                        EFTBD400
00243  01  L931-LINK-AREA.                                              EFTBD400
00244  ++INCLUDE DTSIL931                                               EFTBD400
00245      EJECT                                                        EFTBD400
00246  01  FSKL-REC.                                                    EFTBD400
00247  ++INCLUDE DTSIFSKL                                               EFTBD400
00248      EJECT                                                        EFTBD400
00249  01  L005-LINK-AREA.                                              EFTBD400
00250  ++INCLUDE DTSIL005                                               EFTBD400
00251      EJECT                                                        EFTBD400
00252  LINKAGE SECTION.                                                 EFTBD400
00253      SKIP3                                                        EFTBD400
00254  01  PARM-AREA.                                                   EFTBD400
00255      05  PARM-LENGTH                   PIC S9(04)  COMP.          EFTBD400
00256      05  PARM-DATA.                                               EFTBD400
00257          10  PARM-RUN-TYPE             PIC  X(02).                EFTBD400
00258          10  FILLER                    PIC  X(01).                EFTBD400
00259          10  PARM-PRE-BACKUP-IND       PIC  X(01).                EFTBD400
00260          10  FILLER                    PIC  X(01).                EFTBD400
00261          10  PARM-ONLY-CHECK-PARM-IND  PIC  X(01).                EFTBD400
00262          10  FILLER                    PIC  X(01).                EFTBD400
00263          10  PARM-TRACE-IND            PIC  X(01).                EFTBD400
00264      EJECT                                                        EFTBD400
00265  PROCEDURE DIVISION USING PARM-AREA.                              EFTBD400
00266      SKIP2                                                        EFTBD400
00267      PERFORM I0000-INITIATE THRU I0000-EXIT.                      EFTBD400
00268                                                                   EFTBD400
00269      IF WRK-ONLY-CHECK-PARM-IND = 'Y'                             EFTBD400
00270          NEXT SENTENCE                                            EFTBD400
00271      ELSE                                                         EFTBD400
00272          PERFORM P0000-PROCESS THRU P0000-EXIT.                   EFTBD400
00273                                                                   EFTBD400
00274      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     EFTBD400
00275      SKIP2                                                        EFTBD400
00276      GOBACK.                                                      EFTBD400
00277      EJECT                                                        EFTBD400
00278  I0000-INITIATE.                                                  EFTBD400
00279      SKIP2                                                        EFTBD400
00280      PERFORM I1000-PROCESS-PARMS       THRU I1000-EXIT.           EFTBD400
00281                                                                   EFTBD400
00282      PERFORM I2000-OPEN-FILES-1        THRU I2000-EXIT.           EFTBD400
00283                                                                   EFTBD400
00284      PERFORM I3000-INITIALIZE-WRK      THRU I3000-EXIT.           EFTBD400
00285                                                                   EFTBD400
00286      PERFORM I4000-INITIAL-CALLS       THRU I4000-EXIT.           EFTBD400
00287                                                                   EFTBD400
00288      IF WRK-ONLY-CHECK-PARM-IND = 'Y'                             EFTBD400
00289          NEXT SENTENCE                                            EFTBD400
00290      ELSE                                                         EFTBD400
00291          PERFORM I5000-OPEN-FILES-2    THRU I5000-EXIT.           EFTBD400
00292                                                                   EFTBD400
00293      PERFORM I6000-RERUN-INSTRUCTIONS  THRU I6000-EXIT.           EFTBD400
00294      SKIP2                                                        EFTBD400
00295  I0000-EXIT.                                                      EFTBD400
00296      EXIT.                                                        EFTBD400
00297      EJECT                                                        EFTBD400
00298  I1000-PROCESS-PARMS.                                             EFTBD400
00299      DISPLAY ' '.                                                 EFTBD400
00300                                                                   EFTBD400
00301      DISPLAY '*** EFTBD400 PARAMETERS'.                              CL**2
00302                                                                   EFTBD400
00303                                                                   EFTBD400
00304      IF PARM-LENGTH = +8                                          EFTBD400
00305          NEXT SENTENCE                                            EFTBD400
00306      ELSE                                                         EFTBD400
00307          DISPLAY 'PARM LENGTH NOT EQUAL TO EIGHT'                 EFTBD400
00308          PERFORM S999-ABEND THRU S999-EXIT.                       EFTBD400
00309                                                                   EFTBD400
00310                                                                   EFTBD400
00311      IF PARM-PRE-BACKUP-IND = SPACES                              EFTBD400
00312          MOVE 'N' TO WRK-PRE-BACKUP-IND                           EFTBD400
00313      ELSE                                                         EFTBD400
00314          IF PARM-PRE-BACKUP-IND = 'Y' OR 'N'                      EFTBD400
00315              MOVE PARM-PRE-BACKUP-IND                             EFTBD400
00316                TO WRK-PRE-BACKUP-IND                              EFTBD400
00317          ELSE                                                     EFTBD400
00318              DISPLAY 'PARM PRE BACKUP IND = '                     EFTBD400
00319                      PARM-PRE-BACKUP-IND                          EFTBD400
00320                      ' IS NOT A VALID VALUE'                      EFTBD400
00321              PERFORM S999-ABEND THRU S999-EXIT.                   EFTBD400
00322                                                                   EFTBD400
00323                                                                   EFTBD400
00324      IF PARM-RUN-TYPE = SPACES                                    EFTBD400
00325          MOVE 'OR' TO WRK-RUN-TYPE                                EFTBD400
00326      ELSE                                                         EFTBD400
00327          IF PARM-RUN-TYPE = 'WE' OR 'MC' OR 'ME' OR 'QR' OR 'QP'  EFTBD400
00328                                  OR 'QD'                          EFTBD400
00329                                  OR 'QE' OR 'QF' OR 'YE' OR 'OR'  EFTBD400
00330              MOVE PARM-RUN-TYPE TO WRK-RUN-TYPE                   EFTBD400
00331          ELSE                                                     EFTBD400
00332              DISPLAY 'PARM RUN TYPE = '                           EFTBD400
00333                      PARM-RUN-TYPE                                EFTBD400
00334                      ' IS NOT A VALID RUN TYPE'                   EFTBD400
00335              PERFORM S999-ABEND THRU S999-EXIT.                   EFTBD400
00336                                                                   EFTBD400
00337                                                                   EFTBD400
00338      IF PARM-ONLY-CHECK-PARM-IND = SPACES                         EFTBD400
00339          MOVE 'N' TO WRK-ONLY-CHECK-PARM-IND                      EFTBD400
00340      ELSE                                                         EFTBD400
00341          IF PARM-ONLY-CHECK-PARM-IND = 'Y' OR 'N'                 EFTBD400
00342              MOVE PARM-ONLY-CHECK-PARM-IND                        EFTBD400
00343                TO WRK-ONLY-CHECK-PARM-IND                         EFTBD400
00344          ELSE                                                     EFTBD400
00345              DISPLAY 'PARM ONLY CHECK PARM IND = '                EFTBD400
00346                      PARM-ONLY-CHECK-PARM-IND                     EFTBD400
00347                      ' IS NOT A VALID VALUE'                      EFTBD400
00348              PERFORM S999-ABEND THRU S999-EXIT.                   EFTBD400
00349                                                                   EFTBD400
00350                                                                   EFTBD400
00351      IF PARM-TRACE-IND = SPACES                                   EFTBD400
00352          MOVE 'N' TO WRK-TRACE-IND                                EFTBD400
00353      ELSE                                                         EFTBD400
00354          MOVE PARM-TRACE-IND TO WRK-TRACE-IND.                    EFTBD400
00355                                                                   EFTBD400
00356                                                                   EFTBD400
00357      DISPLAY ' '.                                                 EFTBD400
00358                                                                   EFTBD400
00359      DISPLAY '       RUN TYPE: '                                  EFTBD400
00360              WRK-RUN-TYPE.                                        EFTBD400
00361                                                                   EFTBD400
00362      DISPLAY ' PRE-BACKUP IND: '                                  EFTBD400
00363              WRK-PRE-BACKUP-IND.                                  EFTBD400
00364                                                                   EFTBD400
00365      DISPLAY 'ONLY CHECK PARM: '                                  EFTBD400
00366              WRK-ONLY-CHECK-PARM-IND.                             EFTBD400
00367                                                                   EFTBD400
00368      DISPLAY 'TRACE INDICATOR: '                                  EFTBD400
00369              WRK-TRACE-IND.                                       EFTBD400
00370                                                                   EFTBD400
00371      DISPLAY ' '.                                                 EFTBD400
00372                                                                   EFTBD400
00373                                                                   EFTBD400
00374      OPEN INPUT PARM-FILE.                                        EFTBD400
00375                                                                   EFTBD400
00376      MOVE 'N'   TO PARM-EOF-IND.                                  EFTBD400
00377                                                                   EFTBD400
00378      MOVE +0    TO PARM-REC-CNT.                                  EFTBD400
00379                                                                   EFTBD400
00380      MOVE +0    TO WRK-EXTRACT-CNT.                               EFTBD400
00381                                                                   EFTBD400
00382      PERFORM I1100-READ-PARM  THRU I1100-EXIT                     EFTBD400
00383              UNTIL PARM-EOF-IND = 'Y'.                            EFTBD400
00384                                                                   EFTBD400
00385      IF PARM-REC-CNT < 1 OR > 50                                  EFTBD400
00386         DISPLAY 'MORE THAN 50 PARAMETER RECORDS IS NOT VALID'     EFTBD400
00387         PERFORM S999-ABEND  THRU S999-EXIT.                       EFTBD400
00388                                                                   EFTBD400
00389      CLOSE PARM-FILE.                                             EFTBD400
00390  I1000-EXIT.                                                      EFTBD400
00391      EXIT.                                                        EFTBD400
00392      EJECT                                                        EFTBD400
00393  I1100-READ-PARM.                                                 EFTBD400
00394      READ PARM-FILE                                               EFTBD400
00395          AT END                                                   EFTBD400
00396             MOVE 'Y' TO PARM-EOF-IND                              EFTBD400
00397             GO TO I1100-EXIT.                                     EFTBD400
00398                                                                   EFTBD400
00399                                                                   EFTBD400
00400      DISPLAY '*** '                                               EFTBD400
00401              PARM-REC.                                            EFTBD400
00402                                                                   EFTBD400
00403                                                                   EFTBD400
00404      IF PREC-EXTRACT-ID = '***'                                   EFTBD400
00405          GO TO I1100-EXIT.                                        EFTBD400
00406                                                                   EFTBD400
00407                                                                   EFTBD400
00408      ADD +1 TO PARM-REC-CNT.                                      EFTBD400
00409                                                                   EFTBD400
00410      PERFORM I1200-LOAD-PARM-TABLE  THRU I1200-EXIT.              EFTBD400
00411  I1100-EXIT.                                                      EFTBD400
00412      EXIT.                                                        EFTBD400
00413      EJECT                                                        EFTBD400
00414  I1200-LOAD-PARM-TABLE.                                           EFTBD400
00415      IF WRK-EXTRACT-CNT > 0                                       EFTBD400
00416         PERFORM I1250-DUP-EXTRACT-ID-CHECK THRU I1250-EXIT        EFTBD400
00417            VARYING WRK-SUB FROM 1 BY 1                            EFTBD400
00418            UNTIL WRK-SUB > WRK-EXTRACT-CNT.                       EFTBD400
00419                                                                   EFTBD400
00420      ADD +1 TO WRK-EXTRACT-CNT.                                   EFTBD400
00421                                                                   EFTBD400
00422      IF WRK-EXTRACT-CNT > 50                                      EFTBD400
00423         DISPLAY 'MORE THAN 50 EXTRACT ID CODES INVALID'           EFTBD400
00424         PERFORM S999-ABEND THRU S999-EXIT.                        EFTBD400
00425                                                                   EFTBD400
00426      MOVE PREC-EXTRACT-ID                                         EFTBD400
00427        TO WRK-EXTRACT-ID (WRK-EXTRACT-CNT).                       EFTBD400
00428                                                                   EFTBD400
00429      MOVE PREC-EXTRACT-PARMS                                      EFTBD400
00430        TO WRK-EXTRACT-PARMS (WRK-EXTRACT-CNT).                    EFTBD400
00431  I1200-EXIT.                                                      EFTBD400
00432      EXIT.                                                        EFTBD400
00433      EJECT                                                        EFTBD400
00434  I1250-DUP-EXTRACT-ID-CHECK.                                      EFTBD400
00435      IF PREC-EXTRACT-ID = WRK-EXTRACT-ID (WRK-SUB)                EFTBD400
00436         DISPLAY 'DUPLICATE EXTRACT ID CODES INVALID '             EFTBD400
00437                 WRK-EXTRACT-ID (WRK-SUB)                          EFTBD400
00438         PERFORM S999-ABEND THRU S999-EXIT.                        EFTBD400
00439  I1250-EXIT.                                                      EFTBD400
00440      EXIT.                                                        EFTBD400
00441      EJECT                                                        EFTBD400
00442  I2000-OPEN-FILES-1.                                              EFTBD400
00443      MOVE WRK-TRACE-IND TO L910-TRACE-IND                         EFTBD400
00444                            L921-TRACE-IND                         EFTBD400
00445                            L927-TRACE-IND                         EFTBD400
00446                            L931-TRACE-IND.                        EFTBD400
00447                                                                   EFTBD400
00448      MOVE WRK-MOD-NAME TO L910-MOD-NAME                           EFTBD400
00449                           L921-MOD-NAME                           EFTBD400
00450                           L927-MOD-NAME                           EFTBD400
00451                           L931-MOD-NAME.                          EFTBD400
00452                                                                   EFTBD400
00453      PERFORM S910-OPEN-READ THRU S910-EXIT.                       EFTBD400
00454                                                                   EFTBD400
00455      PERFORM S921-OPEN-READ THRU S921-EXIT.                       EFTBD400
00456                                                                   EFTBD400
00457      PERFORM S927-OPEN-UPDATE THRU S927-EXIT.                     EFTBD400
00458                                                                   EFTBD400
00459      PERFORM S931-OPEN-READ THRU S931-EXIT.                       EFTBD400
00460                                                                   EFTBD400
00461      MOVE LENGTH OF R907-REC TO R907-LENGTH.                      EFTBD400
00462  I2000-EXIT.                                                      EFTBD400
00463      EXIT.                                                        EFTBD400
00464      EJECT                                                        EFTBD400
00465  I3000-INITIALIZE-WRK.                                            EFTBD400
00466      MOVE LOW-VALUES TO MHDR-KEY-AREA.                            EFTBD400
00467                                                                   EFTBD400
00468      MOVE +0 TO MHDR-EMP-NO.                                      EFTBD400
00469                                                                   EFTBD400
00470      SET MHDR-HDR-88 TO TRUE.                                     EFTBD400
00471                                                                   EFTBD400
00472      PERFORM S910-READ THRU S910-EXIT.                            EFTBD400
00473                                                                   EFTBD400
00474      IF L910-NO-REC-88                                            EFTBD400
00475         PERFORM S999-ABEND THRU S999-EXIT.                        EFTBD400
00476                                                                   EFTBD400
00477      PERFORM S005-FROM-SYS THRU S005-EXIT.                        EFTBD400
00478                                                                   EFTBD400
00479      MOVE L005-ABSTIME TO WRK-START-ABSTIME.                      EFTBD400
00480                                                                   EFTBD400
00481      PERFORM I3100-INIT-LECM-PARMS THRU I3100-EXIT.               EFTBD400
00482                                                                   EFTBD400
00483      MOVE +0 TO WRK-MPRF-CNT                                      EFTBD400
00484                 WRK-UPDATED-CNT.                                  EFTBD400
00485  I3000-EXIT.                                                      EFTBD400
00486      EXIT.                                                        EFTBD400
00487      EJECT                                                        EFTBD400
00488  I3100-INIT-LECM-PARMS.                                           EFTBD400
00489      MOVE WRK-RUN-TYPE TO LECM-RUN-TYPE.                          EFTBD400
00490                                                                   EFTBD400
00491      IF WRK-RUN-TYPE = 'WE'                                       EFTBD400
00492         MOVE MHDR-CMPL-WEEK-BEGIN-DATE TO LECM-PERIOD-START-DATE  EFTBD400
00493         MOVE MHDR-CMPL-WEEK-END-DATE TO LECM-PERIOD-END-DATE      EFTBD400
00494      ELSE                                                         EFTBD400
00495      IF WRK-RUN-TYPE = 'MC' OR 'ME'                               EFTBD400
00496         MOVE MHDR-CMPL-MONTH-BEGIN-DATE TO LECM-PERIOD-START-DATE EFTBD400
00497         MOVE MHDR-CMPL-MONTH-END-DATE TO LECM-PERIOD-END-DATE     EFTBD400
00498      ELSE                                                         EFTBD400
00499      IF WRK-RUN-TYPE = 'QR' OR 'QD' OR 'QE' OR 'QF' OR 'QP'       EFTBD400
00500         MOVE MHDR-CMPL-QTR-BEGIN-DATE TO LECM-PERIOD-START-DATE   EFTBD400
00501         MOVE MHDR-CMPL-QTR-END-DATE TO LECM-PERIOD-END-DATE       EFTBD400
00502      ELSE                                                         EFTBD400
00503      IF WRK-RUN-TYPE = 'YE'                                       EFTBD400
00504         MOVE MHDR-CMPL-YEAR-BEGIN-DATE TO LECM-PERIOD-START-DATE  EFTBD400
00505         MOVE MHDR-CMPL-YEAR-END-DATE TO LECM-PERIOD-END-DATE      EFTBD400
00506      ELSE                                                         EFTBD400
00507         MOVE +0 TO LECM-PERIOD-START-DATE                         EFTBD400
00508         MOVE +0 TO LECM-PERIOD-END-DATE.                          EFTBD400
00509                                                                   EFTBD400
00510      MOVE L005-ABSTIME TO LECM-RUN-ABSTIME.                       EFTBD400
00511                                                                   EFTBD400
00512      MOVE L005-DATE TO LECM-SYS-DATE.                             EFTBD400
00513                                                                   EFTBD400
00514      MOVE L005-TIME TO LECM-SYS-TIME.                             EFTBD400
00515                                                                   EFTBD400
00516      MOVE MHDR-CURR-RUN-DATE TO LECM-CURR-RUN-DATE.               EFTBD400
00517                                                                   EFTBD400
00518      MOVE MHDR-CURR-MAIL-DATE TO LECM-CURR-MAIL-DATE.             EFTBD400
00519                                                                   EFTBD400
00520      MOVE MHDR-PRIOR-RUN-DATE TO LECM-PRIOR-RUN-DATE.             EFTBD400
00521                                                                   EFTBD400
00522      MOVE MHDR-PRIOR-MAIL-DATE TO LECM-PRIOR-MAIL-DATE.           EFTBD400
00523                                                                   EFTBD400
00524      MOVE MHDR-LAST-UC30-MASS-MAIL-YRQ                            EFTBD400
00525        TO LECM-LAST-UC30-MASS-MAIL-YRQ.                           EFTBD400
00526                                                                   EFTBD400
00527      MOVE MHDR-LAST-PEN-ASSESSED-YRQ                              EFTBD400
00528        TO LECM-LAST-PEN-ASSESSED-YRQ.                             EFTBD400
00529                                                                   EFTBD400
00530      MOVE MHDR-LAST-UC30-DEL-MAIL-YRQ                             EFTBD400
00531        TO LECM-LAST-UC30-DEL-MAIL-YRQ.                            EFTBD400
00532                                                                   EFTBD400
00533      MOVE MHDR-FIRST-PURSUED-RPT-YRQ                              EFTBD400
00534        TO LECM-FIRST-PURSUED-RPT-YRQ.                             EFTBD400
00535                                                                   EFTBD400
00536      MOVE MHDR-LAST-RATE-END-YRQ                                  EFTBD400
00537        TO LECM-LAST-RATE-END-YRQ.                                 EFTBD400
00538                                                                   EFTBD400
00539      MOVE MHDR-LAST-MJRN-PURGE-DATE                               EFTBD400
00540        TO LECM-LAST-MJRN-PURGE-DATE.                              EFTBD400
00541                                                                   EFTBD400
00542      MOVE +19924 TO LECM-PICKUP-YRQ.                              EFTBD400
00543                                                                   EFTBD400
00544      MOVE WRK-TRACE-IND TO LECM-TRACE-IND.                        EFTBD400
00545  I3100-EXIT.                                                      EFTBD400
00546      EXIT.                                                        EFTBD400
00547      EJECT                                                        EFTBD400
00548  I4000-INITIAL-CALLS.                                             EFTBD400
00549      SET LECM-INITIALIZE-88 TO TRUE.                              EFTBD400
00550                                                                   EFTBD400
00551      SET LECM-MST-OPEN-READ-88 TO TRUE.                           EFTBD400
00552                                                                   EFTBD400
00553      SET LECM-REF-OPEN-READ-88 TO TRUE.                           EFTBD400
00554                                                                   EFTBD400
00555      MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND.                  EFTBD400
00556                                                                   EFTBD400
00557      MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND.                  EFTBD400
00558                                                                   EFTBD400
00559      PERFORM I4100-EXTRACT-LOOP THRU I4100-EXIT                   EFTBD400
00560          VARYING WRK-EXT-IDX FROM 1 BY 1                          EFTBD400
00561          UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                     EFTBD400
00562  I4000-EXIT.                                                      EFTBD400
00563      EXIT.                                                        EFTBD400
00564      SKIP3                                                        EFTBD400
00565  I4100-EXTRACT-LOOP.                                              EFTBD400
00566      SET LECM-MST-OPEN-READ-88 TO TRUE.                           EFTBD400
00567                                                                   EFTBD400
00568      SET LECM-REF-OPEN-READ-88 TO TRUE.                           EFTBD400
00569                                                                   EFTBD400
00570      PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT.                  EFTBD400
00571                                                                   EFTBD400
00572      IF LECM-MST-OPEN-IND > WRK-MST-OPEN-IND                      EFTBD400
00573          MOVE LECM-MST-OPEN-IND TO WRK-MST-OPEN-IND.              EFTBD400
00574                                                                   EFTBD400
00575      IF LECM-REF-OPEN-IND > WRK-REF-OPEN-IND                      EFTBD400
00576          MOVE LECM-REF-OPEN-IND TO WRK-REF-OPEN-IND.              EFTBD400
00577  I4100-EXIT.                                                      EFTBD400
00578      EXIT.                                                        EFTBD400
00579      EJECT                                                        EFTBD400
00580  I5000-OPEN-FILES-2.                                              EFTBD400
00581      MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND.                  EFTBD400
00582                                                                   EFTBD400
00583      MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND.                  EFTBD400
00584                                                                   EFTBD400
00585      IF (LECM-MST-OPEN-UPDATE-HDR-88)                             EFTBD400
00586            OR                                                     EFTBD400
00587         (LECM-MST-OPEN-UPDATE-88)                                 EFTBD400
00588          IF WRK-PRE-BACKUP-IND = 'Y'                              EFTBD400
00589              NEXT SENTENCE                                        EFTBD400
00590          ELSE                                                     EFTBD400
00591              DISPLAY 'MASTER FILE UPDATING POSSIBLE '             EFTBD400
00592                      'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"'   EFTBD400
00593              PERFORM S999-ABEND THRU S999-EXIT.                   EFTBD400
00594                                                                   EFTBD400
00595      IF LECM-MST-OPEN-READ-88                                     EFTBD400
00596          NEXT SENTENCE                                            EFTBD400
00597      ELSE                                                         EFTBD400
00598          PERFORM S910-CLOSE THRU S910-EXIT                        EFTBD400
00599          IF LECM-MST-OPEN-UPDATE-HDR-88                           EFTBD400
00600              PERFORM S910-OPEN-UPDATE-HDR THRU S910-EXIT          EFTBD400
00601          ELSE                                                     EFTBD400
00602          IF LECM-MST-OPEN-UPDATE-88                               EFTBD400
00603              PERFORM S921-CLOSE THRU S921-EXIT                    EFTBD400
00604              PERFORM S910-OPEN-UPDATE THRU S910-EXIT              EFTBD400
00605              PERFORM S921-OPEN-UPDATE THRU S921-EXIT              EFTBD400
00606          ELSE                                                     EFTBD400
00607              PERFORM S999-ABEND THRU S999-EXIT.                   EFTBD400
00608                                                                   EFTBD400
00609      IF LECM-REF-OPEN-UPDATE-88                                   EFTBD400
00610          IF WRK-PRE-BACKUP-IND = 'Y'                              EFTBD400
00611              NEXT SENTENCE                                        EFTBD400
00612          ELSE                                                     EFTBD400
00613              DISPLAY 'REFERENCE FILE UPDATING POSSIBLE '          EFTBD400
00614                      'BUT PARM-PRE-BACKUP-IND NOT EQUAL TO "Y"'   EFTBD400
00615              PERFORM S999-ABEND THRU S999-EXIT.                   EFTBD400
00616                                                                   EFTBD400
00617      IF LECM-REF-OPEN-UPDATE-88                                   EFTBD400
00618          PERFORM S931-CLOSE THRU S931-EXIT                        EFTBD400
00619          PERFORM S931-OPEN-UPDATE THRU S931-EXIT.                 EFTBD400
00620  I5000-EXIT.                                                      EFTBD400
00621      EXIT.                                                        EFTBD400
00622      EJECT                                                        EFTBD400
00623  I6000-RERUN-INSTRUCTIONS.                                        EFTBD400
00624      DISPLAY ' '.                                                 EFTBD400
00625                                                                   EFTBD400
00626      DISPLAY ' '.                                                 EFTBD400
00627                                                                   EFTBD400
00628      DISPLAY '****************************************'           EFTBD400
00629              '****************************************'.          EFTBD400
00630                                                                   EFTBD400
00631      DISPLAY '**                                      '           EFTBD400
00632              '                                      **'.          EFTBD400
00633                                                                   EFTBD400
00634      DISPLAY '**                        EFTBD400 RERUN'              CL**2
00635              ' INSTRUCTIONS                         **'.          EFTBD400
00636                                                                   EFTBD400
00637      DISPLAY '**                                      '           EFTBD400
00638              '                                      **'.          EFTBD400
00639                                                                   EFTBD400
00640      DISPLAY '**     IF EFTBD400 ABENDS THEN:         '              CL**2
00641              '                                      **'.          EFTBD400
00642                                                                   EFTBD400
00643      IF LECM-MST-OPEN-UPDATE-HDR-88                               EFTBD400
00644          DISPLAY '**                                      '       EFTBD400
00645                  '                                      **'       EFTBD400
00646          DISPLAY '**          RESTORE MASTER FILE HEADER R'       EFTBD400
00647                  'ECORD PRIOR TO ATTEMPTING RERUN.      **'.      EFTBD400
00648                                                                   EFTBD400
00649      IF LECM-MST-OPEN-UPDATE-88                                   EFTBD400
00650          DISPLAY '**                                      '       EFTBD400
00651                  '                                      **'       EFTBD400
00652          DISPLAY '**          RESTORE MASTER FILE PRIOR TO'       EFTBD400
00653                  ' ATTEMPTING RERUN.                    **'.      EFTBD400
00654                                                                   EFTBD400
00655      IF LECM-REF-OPEN-UPDATE-88                                   EFTBD400
00656          DISPLAY '**                                      '       EFTBD400
00657                  '                                      **'       EFTBD400
00658          DISPLAY '**          RESTORE REFERENCE FILE PRIOR'       EFTBD400
00659                  ' TO ATTEMPTING RERUN.                 **'.      EFTBD400
00660                                                                   EFTBD400
00661      IF (LECM-MST-OPEN-UPDATE-HDR-88)                             EFTBD400
00662               OR                                                  EFTBD400
00663         (LECM-MST-OPEN-UPDATE-88)                                 EFTBD400
00664               OR                                                  EFTBD400
00665         (LECM-REF-OPEN-UPDATE-88)                                 EFTBD400
00666          NEXT SENTENCE                                            EFTBD400
00667      ELSE                                                         EFTBD400
00668          DISPLAY '**                                      '       EFTBD400
00669                  '                                      **'       EFTBD400
00670          DISPLAY '**          NO SPECIAL ACTIONS NEEDED.  '       EFTBD400
00671                  '                                      **'.      EFTBD400
00672                                                                   EFTBD400
00673      DISPLAY '**                                      '           EFTBD400
00674              '                                      **'.          EFTBD400
00675                                                                   EFTBD400
00676      DISPLAY '****************************************'           EFTBD400
00677              '****************************************'.          EFTBD400
00678                                                                   EFTBD400
00679      DISPLAY ' '.                                                 EFTBD400
00680                                                                   EFTBD400
00681      DISPLAY ' '.                                                 EFTBD400
00682  I6000-EXIT.                                                      EFTBD400
00683      EXIT.                                                        EFTBD400
00684      EJECT                                                        EFTBD400
00685  P0000-PROCESS.                                                   EFTBD400
00686      SET LECM-PROCESS-88 TO TRUE.                                 EFTBD400
00687                                                                   EFTBD400
00688      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            EFTBD400
00689                                                                   EFTBD400
00690      MOVE +0 TO MPRF-EMP-NO.                                      EFTBD400
00691                                                                   EFTBD400
00692      SET MPRF-PRF-88 TO TRUE.                                     EFTBD400
00693                                                                   EFTBD400
00694      PERFORM S910-START-BROWSE THRU S910-EXIT.                    EFTBD400
00695                                                                   EFTBD400
00696      PERFORM P1000-READ-NEXT THRU P1000-EXIT                      EFTBD400
00697         UNTIL L910-NO-REC-88.                                     EFTBD400
00698  P0000-EXIT.                                                      EFTBD400
00699      EXIT.                                                        EFTBD400
00700      EJECT                                                        EFTBD400
00701  P1000-READ-NEXT.                                                 EFTBD400
00702      ADD +1 TO WRK-MPRF-CNT.                                      EFTBD400
00703                                                                   EFTBD400
00704      SET WRK-EMP-UPDATED-NO-88 TO TRUE.                           EFTBD400
00705                                                                   EFTBD400
00706      MOVE LECM-RUN-ABSTIME TO LECM-EMP-ABSTIME.                   EFTBD400
00707                                                                   EFTBD400
00708      PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT                   EFTBD400
00709              VARYING WRK-EXT-IDX FROM 1 BY 1                      EFTBD400
00710              UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                 EFTBD400
00711                                                                   EFTBD400
00712      IF WRK-EMP-UPDATED-YES-88                                    EFTBD400
00713          PERFORM P1100-EMPLOYER-UPDATED THRU P1100-EXIT.          EFTBD400
00714                                                                   EFTBD400
00715      PERFORM S910-READ-NEXT THRU S910-EXIT.                       EFTBD400
00716  P1000-EXIT.                                                      EFTBD400
00717      EXIT.                                                        EFTBD400
00718      SKIP3                                                        EFTBD400
00719  P1100-EMPLOYER-UPDATED.                                          EFTBD400
00720      IF MPRF-UPDATE-ACTIVE-88                                     EFTBD400
00721          NEXT SENTENCE                                            EFTBD400
00722      ELSE                                                         EFTBD400
00723          MOVE LECM-RUN-ABSTIME TO MPRF-UPDATE-END-ABSTIME         EFTBD400
00724          MOVE +0 TO MPRF-UPDATE-TASK-ID                           EFTBD400
00725          MOVE 'BATCH' TO MPRF-UPDATE-OP-ID                        EFTBD400
00726          MOVE SPACES TO MPRF-UPDATE-TERMID                        EFTBD400
00727          MOVE SPACES TO MPRF-UPDATE-NETNAME                       EFTBD400
00728          MOVE LECM-SYS-DATE TO MPRF-UPDATE-START-DATE             EFTBD400
00729          MOVE LECM-SYS-TIME TO MPRF-UPDATE-START-TIME             EFTBD400
00730          MOVE SPACES TO MPRF-UPDATE-SCR-ID                        EFTBD400
00731                         MPRF-UPDATE-FUNCTION                      EFTBD400
00732          MOVE LECM-CURR-RUN-DATE TO MPRF-CHNG-DATE.               EFTBD400
00733                                                                   EFTBD400
00734      PERFORM S910-REWRITE THRU S910-EXIT.                         EFTBD400
00735                                                                   EFTBD400
00736      ADD +1 TO WRK-UPDATED-CNT.                                   EFTBD400
00737  P1100-EXIT.                                                      EFTBD400
00738      EXIT.                                                        EFTBD400
00739      EJECT                                                        EFTBD400
00740  T0000-TERMINATE.                                                 EFTBD400
00741      IF WRK-ONLY-CHECK-PARM-IND = 'Y'                             EFTBD400
00742          NEXT SENTENCE                                            EFTBD400
00743      ELSE                                                         EFTBD400
00744          SET LECM-TERMINATE-88 TO TRUE                            EFTBD400
00745          PERFORM S1000-CALL-EXTRACT THRU S1000-EXIT               EFTBD400
00746              VARYING WRK-EXT-IDX FROM 1 BY 1                      EFTBD400
00747              UNTIL WRK-EXT-IDX > WRK-EXTRACT-CNT.                 EFTBD400
00748                                                                   EFTBD400
00749                                                                   EFTBD400
00750      DISPLAY ' '.                                                 EFTBD400
00751                                                                   EFTBD400
00752      DISPLAY '*** EFTBD400 TERMINATION STATISTICS ***'.              CL**2
00753                                                                   EFTBD400
00754      DISPLAY ' '.                                                 EFTBD400
00755                                                                   EFTBD400
00756      DISPLAY 'NUMBER OF MASTER FILE PROFILE RECORDS ENCOUNTERED: 'EFTBD400
00757              WRK-MPRF-CNT.                                        EFTBD400
00758                                                                   EFTBD400
00759      DISPLAY ' '.                                                 EFTBD400
00760                                                                   EFTBD400
00761      DISPLAY 'NUMBER OF MASTER FILE EMPLOYERS UPDATED          : 'EFTBD400
00762              WRK-UPDATED-CNT.                                     EFTBD400
00763                                                                   EFTBD400
00764      DISPLAY ' '.                                                 EFTBD400
00765                                                                   EFTBD400
00766      DISPLAY 'MODULE LINKAGE - RUN TYPE            : '            EFTBD400
00767              LECM-RUN-TYPE.                                       EFTBD400
00768                                                                   EFTBD400
00769      DISPLAY ' '.                                                 EFTBD400
00770                                                                   EFTBD400
00771      DISPLAY 'MODULE LINKAGE - PERIOD START DATE   : '            EFTBD400
00772              LECM-PERIOD-START-DATE.                              EFTBD400
00773                                                                   EFTBD400
00774      DISPLAY ' '.                                                 EFTBD400
00775                                                                   EFTBD400
00776      DISPLAY 'MODULE LINKAGE - PERIOD END DATE     : '            EFTBD400
00777              LECM-PERIOD-END-DATE.                                EFTBD400
00778                                                                   EFTBD400
00779      DISPLAY ' '.                                                 EFTBD400
00780                                                                   EFTBD400
00781                                                                   EFTBD400
00782      PERFORM S910-CLOSE THRU S910-EXIT.                           EFTBD400
00783                                                                   EFTBD400
00784      PERFORM S921-CLOSE THRU S921-EXIT.                           EFTBD400
00785                                                                   EFTBD400
00786      PERFORM S927-CLOSE THRU S927-EXIT.                           EFTBD400
00787                                                                   EFTBD400
00788      PERFORM S931-CLOSE THRU S931-EXIT.                           EFTBD400
00789                                                                   EFTBD400
00790      MOVE -1 TO RSK1-LENGTH.                                      EFTBD400
00791                                                                   EFTBD400
00792      PERFORM S946-RPT-O THRU S946-EXIT.                           EFTBD400
00793                                                                   EFTBD400
00794                                                                   EFTBD400
00795      PERFORM S005-FROM-SYS THRU S005-EXIT.                        EFTBD400
00796                                                                   EFTBD400
00797      COMPUTE WRK-STEP-DURATION ROUNDED                            EFTBD400
00798        = (L005-ABSTIME - WRK-START-ABSTIME ) / 1000.              EFTBD400
00799                                                                   EFTBD400
00800      DISPLAY '*** '                                               EFTBD400
00801              WRK-STEP-DURATION-X                                  EFTBD400
00802              ' STEP DURATION (SECONDS)'.                          EFTBD400
00803                                                                   EFTBD400
00804 *****MOVE WRK-MST-OPEN-IND TO LECM-MST-OPEN-IND.                  EFTBD400
00805                                                                   EFTBD400
00806 *****MOVE WRK-REF-OPEN-IND TO LECM-REF-OPEN-IND.                  EFTBD400
00807                                                                   EFTBD400
00808 *****IF LECM-MST-OPEN-READ-88                                     EFTBD400
00809 *****    MOVE +0 TO RETURN-CODE                                   EFTBD400
00810 *****ELSE                                                         EFTBD400
00811 *****IF LECM-MST-OPEN-UPDATE-HDR-88                               EFTBD400
00812 *****    MOVE +1 TO RETURN-CODE                                   EFTBD400
00813 *****ELSE                                                         EFTBD400
00814 *****    MOVE +2 TO RETURN-CODE.                                  EFTBD400
00815  T0000-EXIT.                                                      EFTBD400
00816      EXIT.                                                        EFTBD400
00817      EJECT                                                        EFTBD400
00818  S1000-CALL-EXTRACT.                                              EFTBD400
00819      SET LECM-EMP-UPDATED-NO-88 TO TRUE.                          EFTBD400
00820                                                                   EFTBD400
00821      MOVE WRK-EXTRACT-PARMS (WRK-EXT-IDX)                         EFTBD400
00822        TO LECM-EXTRACT-PARMS.                                     EFTBD400
00823                                                                   EFTBD400
00824      MOVE WRK-EXTRACT-ID (WRK-EXT-IDX) TO EXTRACT-MOD-ID.         EFTBD400
00825                                                                   EFTBD400
00826      CALL EXTRACT-MOD-NAME USING LECM-LINK-AREA                   EFTBD400
00827                                  MPRF-REC.                        EFTBD400
00828                                                                   EFTBD400
00829      IF LECM-EMP-UPDATED-YES-88                                   EFTBD400
00830          PERFORM S1100-EMPLOYER-UPDATED THRU S1100-EXIT.          EFTBD400
00831  S1000-EXIT.                                                      EFTBD400
00832      EXIT.                                                        EFTBD400
00833      SKIP3                                                        EFTBD400
00834  S1100-EMPLOYER-UPDATED.                                          EFTBD400
00835      IF LECM-PROCESS-88                                           EFTBD400
00836          NEXT SENTENCE                                            EFTBD400
00837      ELSE                                                         EFTBD400
00838          GO TO S1100-EXIT.                                        EFTBD400
00839                                                                   EFTBD400
00840      SET WRK-EMP-UPDATED-YES-88 TO TRUE.                          EFTBD400
00841                                                                   EFTBD400
00842      IF MPRF-UPDATE-ACTIVE-88                                     EFTBD400
00843          MOVE MSG1-ID TO R907-MSG-ID                              EFTBD400
00844          MOVE MPRF-EMP-NO TO R907-EMP-NO                          EFTBD400
00845          MOVE EXTRACT-MOD-ID TO MSG1-EXTRACT-ID                   EFTBD400
00846          MOVE MSG1-TEXT TO R907-MSG-TEXT                          EFTBD400
00847          MOVE WRK-MOD-NAME TO R907-MODULE-NAME                    EFTBD400
00848          MOVE R907-REC TO RSKL-REC                                EFTBD400
00849          PERFORM S946-RPT-O THRU S946-EXIT.                       EFTBD400
00850  S1100-EXIT.                                                      EFTBD400
00851      EXIT.                                                        EFTBD400
00852      EJECT                                                        EFTBD400
00853  S005-FROM-SYS.                                                   EFTBD400
00854      SET L005-FROM-SYS TO TRUE.                                   EFTBD400
00855      GO TO S005-ABSTIME.                                          EFTBD400
00856                                                                   EFTBD400
00857  S005-ABSTIME.                                                    EFTBD400
00858      CALL 'DTSBU005' USING L005-LINK-AREA.                        EFTBD400
00859  S005-EXIT.                                                       EFTBD400
00860      EXIT.                                                        EFTBD400
00861      SKIP3                                                        EFTBD400
00862  S910-OPEN-READ.                                                  EFTBD400
00863      SET L910-OPEN-READ-88 TO TRUE.                               EFTBD400
00864      GO TO S910-MSTR-IO.                                          EFTBD400
00865                                                                   EFTBD400
00866  S910-OPEN-UPDATE-HDR.                                            EFTBD400
00867      SET L910-OPEN-UPDATE-HDR-88 TO TRUE.                         EFTBD400
00868      GO TO S910-MSTR-IO.                                          EFTBD400
00869                                                                   EFTBD400
00870  S910-OPEN-UPDATE.                                                EFTBD400
00871      SET L910-OPEN-UPDATE-88 TO TRUE.                             EFTBD400
00872      GO TO S910-MSTR-IO.                                          EFTBD400
00873                                                                   EFTBD400
00874  S910-READ.                                                       EFTBD400
00875      SET L910-READ-88 TO TRUE.                                    EFTBD400
00876      GO TO S910-MSTR-IO.                                          EFTBD400
00877                                                                   EFTBD400
00878  S910-START-BROWSE.                                               EFTBD400
00879      SET L910-START-BROWSE-88 TO TRUE.                            EFTBD400
00880      GO TO S910-MSTR-IO.                                          EFTBD400
00881                                                                   EFTBD400
00882  S910-READ-NEXT.                                                  EFTBD400
00883      SET L910-READ-NEXT-88 TO TRUE.                               EFTBD400
00884      GO TO S910-MSTR-IO.                                          EFTBD400
00885                                                                   EFTBD400
00886  S910-REWRITE.                                                    EFTBD400
00887      SET L910-REWRITE-88 TO TRUE.                                 EFTBD400
00888      GO TO S910-MSTR-IO.                                          EFTBD400
00889                                                                   EFTBD400
00890  S910-CLOSE.                                                      EFTBD400
00891      SET L910-CLOSE-88     TO TRUE.                               EFTBD400
00892      GO TO S910-MSTR-IO.                                          EFTBD400
00893                                                                   EFTBD400
00894  S910-MSTR-IO.                                                    EFTBD400
00895      CALL 'DTSBU910' USING L910-LINK-AREA                         EFTBD400
00896                            MSKL-REC.                              EFTBD400
00897  S910-EXIT.                                                       EFTBD400
00898      EXIT.                                                        EFTBD400
00899      SKIP3                                                        EFTBD400
00900  S921-OPEN-READ.                                                  EFTBD400
00901      SET L921-OPEN-READ-88 TO TRUE.                               EFTBD400
00902      GO TO S921-AIX-IO.                                           EFTBD400
00903                                                                   EFTBD400
00904  S921-OPEN-UPDATE.                                                EFTBD400
00905      SET L921-OPEN-UPDATE-88 TO TRUE.                             EFTBD400
00906      GO TO S921-AIX-IO.                                           EFTBD400
00907                                                                   EFTBD400
00908  S921-CLOSE.                                                      EFTBD400
00909      SET L921-CLOSE-88 TO TRUE.                                   EFTBD400
00910      GO TO S921-AIX-IO.                                           EFTBD400
00911                                                                   EFTBD400
00912  S921-AIX-IO.                                                     EFTBD400
00913      CALL 'DTSBU921' USING L921-LINK-AREA                         EFTBD400
00914                            ISKL-REC.                              EFTBD400
00915  S921-EXIT.                                                       EFTBD400
00916      EXIT.                                                        EFTBD400
00917      SKIP3                                                        EFTBD400
00918  S927-OPEN-UPDATE.                                                EFTBD400
00919      SET L927-OPEN-UPDATE-88 TO TRUE.                             EFTBD400
00920      GO TO S927-BTC-O.                                            EFTBD400
00921                                                                   EFTBD400
00922  S927-CLOSE.                                                      EFTBD400
00923      SET L927-CLOSE-88 TO TRUE.                                   EFTBD400
00924      GO TO S927-BTC-O.                                            EFTBD400
00925                                                                   EFTBD400
00926  S927-BTC-O.                                                      EFTBD400
00927      CALL 'DTSBU927' USING L927-LINK-AREA                         EFTBD400
00928                            RSKL-REC.                              EFTBD400
00929  S927-EXIT.                                                       EFTBD400
00930      EXIT.                                                        EFTBD400
00931      SKIP3                                                        EFTBD400
00932  S931-OPEN-READ.                                                  EFTBD400
00933      SET L931-OPEN-READ-88 TO TRUE.                               EFTBD400
00934      GO TO S931-REF-IO.                                           EFTBD400
00935                                                                   EFTBD400
00936  S931-OPEN-UPDATE.                                                EFTBD400
00937      SET L931-OPEN-UPDATE-88 TO TRUE.                             EFTBD400
00938      GO TO S931-REF-IO.                                           EFTBD400
00939                                                                   EFTBD400
00940  S931-CLOSE.                                                      EFTBD400
00941      SET L931-CLOSE-88 TO TRUE.                                   EFTBD400
00942      GO TO S931-REF-IO.                                           EFTBD400
00943                                                                   EFTBD400
00944  S931-REF-IO.                                                     EFTBD400
00945      CALL 'DTSBU931' USING L931-LINK-AREA                         EFTBD400
00946                            FSKL-REC.                              EFTBD400
00947  S931-EXIT.                                                       EFTBD400
00948      EXIT.                                                        EFTBD400
00949      SKIP3                                                        EFTBD400
00950  S946-RPT-O.                                                      EFTBD400
00951      CALL 'DTSBU946' USING RSKL-REC.                              EFTBD400
00952  S946-EXIT.                                                       EFTBD400
00953      EXIT.                                                        EFTBD400
00954      SKIP3                                                        EFTBD400
00955  S999-ABEND.                                                      EFTBD400
00956      CALL 'DTSBU999' USING WRK-ABEND-CD.                          EFTBD400
00957  S999-EXIT.                                                       EFTBD400
00958      EXIT.                                                        EFTBD400
