00001  IDENTIFICATION DIVISION.                                         10/09/03
00002  PROGRAM-ID.             EFTBD800.                                EFTBD800
00003  AUTHOR.                 NGI.                                        LV002
00004  DATE-WRITTEN.           OCTOBER 2003.                               CL**2
00005  DATE-COMPILED.                                                   EFTBD800
00006                                                                   EFTBD800
00007 *****                                                             EFTBD800
00008 *                                                                 EFTBD800
00009 *    FUNCTION:  REPORT DRIVER MODULE.                             EFTBD800
00010 *                                                                 EFTBD800
00011 *                                                                 EFTBD800
00012 *    MODIFICATION HISTORY:                                        EFTBD800
00013 *                                                                 EFTBD800
00014 * 10-09-03 INITIAL DEVELOPMENT              COPIED FROM DTSBD800     CL**2
00015 *          REFERENCE: EFT                 AUTHOR OF CHANGE - ZL1     CL**2
00016 *                                                                 EFTBD800
00017 *                                                                 EFTBD800
00018 * MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   EFTBD800
00019 *             XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   EFTBD800
00020 *             REFERENCE: XXXXXXXXXXXXXXX        PROGRAMMER: XXX   EFTBD800
00021 *                                                                 EFTBD800
00022 *                                                                 EFTBD800
00023 *  DESCRIPTION:                                                   EFTBD800
00024 *                                                                 EFTBD800
00025 *      THE FUNCTION OF EFTBD800 IS TO READ THE SORTED INCOMING       CL**2
00026 *      REPORT RECORD FILE AND CALL THE APPROPRIATE MODULE TO      EFTBD800
00027 *      PROCESS EACH REPORT RECORD. THE RECORD TYPE IS APPENDED    EFTBD800
00028 *      TO THE CONSTANT 'EFTBR' TO FORM THE LOAD MODULE NAME          CL**2
00029 *      ASSOCIATED WITH THE RECORD.                                EFTBD800
00030 *                                                                 EFTBD800
00031 *      TWO TYPES OF PARAMETER FILES ARE INPUT:                    EFTBD800
00032 *                                                                 EFTBD800
00033 *   -  ONE PARAMETER FILE (CALLED PARM-FILE) SPECIFIES WHICH OF   EFTBD800
00034 *      THE INCOMING REPORT RECORD TYPES ARE TO BE PROCESSED, THIS EFTBD800
00035 *      IS DONE BY EITHER SPECIFYING:                              EFTBD800
00036 *         A: REPORT RECORD TYPES TO BE INCLUDED (PROCESSED)       EFTBD800
00037 *                    OR                                           EFTBD800
00038 *         B: REPORT RECORD TYPES TO BE EXCLUDED (NOT PROCESSED).  EFTBD800
00039 *                                                                 EFTBD800
00040 *   -  THE OTHER PARAMETER FILE (CALLED ATLEAST-ONCE-FILE)        EFTBD800
00041 *      SPECIFIES THE REPORT RECORD TYPES CORRESPONDING TO ALL     EFTBD800
00042 *      REPORT MODULES WHICH MUST BE EXECUTED AT LEAST ONCE.       EFTBD800
00043 *                                                                 EFTBD800
00044 *                                                                 EFTBD800
00045 *   -  THE TABLE INTRODUCED FOR EFTBR980 IS 999 ENTRIES LONG         CL**2
00046 *      TO HANDLE EVERY POSSIBLE REPORT PROGRAM                    EFTBD800
00047 *      (EFTBR001 TO EFTBR999).                                       CL**2
00048 *                                                                 EFTBD800
00049 *                                                                 EFTBD800
00050 *    MODULES CALLED:                                              EFTBD800
00051 *                                                                 EFTBD800
00052 *        DTSBR980  REPORT CONTROL LIST                            EFTBD800
00053 *        DTSBU001  DATE MODULE                                    EFTBD800
00054 *        DTSBU119  AGENCY FACTS MODULE                            EFTBD800
00055 *        DTSBU931  REFERENCE FILE I-O MODULE                      EFTBD800
00056 *        DTSBU941  REPORT FILE SEQUENTIAL INPUT MODULE            EFTBD800
00057 *        DTSBU999  ABEND MODULE                                   EFTBD800
00058 *                                                                 EFTBD800
00059 *****                                                             EFTBD800
00060      EJECT                                                        EFTBD800
00061  ENVIRONMENT DIVISION.                                            EFTBD800
00062                                                                   EFTBD800
00063  INPUT-OUTPUT SECTION.                                            EFTBD800
00064                                                                   EFTBD800
00065  FILE-CONTROL.                                                    EFTBD800
00066      SELECT PARM-FILE ASSIGN TO PARMIN.                           EFTBD800
00067      SELECT ATLEAST-ONCE-FILE ASSIGN TO ATLSTIN.                  EFTBD800
00068                                                                   EFTBD800
00069  DATA DIVISION.                                                   EFTBD800
00070                                                                   EFTBD800
00071  FILE SECTION.                                                    EFTBD800
00072                                                                   EFTBD800
00073  FD  PARM-FILE                                                    EFTBD800
00074      LABEL RECORDS ARE STANDARD.                                  EFTBD800
00075                                                                   EFTBD800
00076  01  PARM-REC.                                                    EFTBD800
00077      05  PARM-MOD-NAME               PIC  X(08).                  EFTBD800
00078      05  FILLER                      PIC  X(01).                  EFTBD800
00079      05  PARM-CONTROL-TYPE           PIC  X(03).                  EFTBD800
00080      05  PARM-RPT-TYPE-AREA OCCURS 15 TIMES                       EFTBD800
00081                             INDEXED BY PARM-RPT-IDX.              EFTBD800
00082          10  FILLER                  PIC  X(01).                  EFTBD800
00083          10  PARM-RPT-TYPE           PIC  X(03).                  EFTBD800
00084      05  FILLER                      PIC  X(08).                  EFTBD800
00085                                                                   EFTBD800
00086                                                                   EFTBD800
00087                                                                   EFTBD800
00088  FD  ATLEAST-ONCE-FILE                                            EFTBD800
00089      LABEL RECORDS ARE STANDARD.                                  EFTBD800
00090                                                                   EFTBD800
00091  01  ATLEAST-ONCE-REC.                                            EFTBD800
00092      05  ATLEAST-ONCE-MOD-NAME       PIC  X(08).                  EFTBD800
00093      05  ATLEAST-ONCE-RPT-TYPE-AREA OCCURS 15 TIMES               EFTBD800
00094                             INDEXED BY ATLEAST-ONCE-RPT-IDX.      EFTBD800
00095          10  FILLER                  PIC  X(01).                  EFTBD800
00096          10  ATLEAST-ONCE-RPT-TYPE   PIC  X(03).                  EFTBD800
00097      05  FILLER                      PIC  X(12).                  EFTBD800
00098      EJECT                                                        EFTBD800
00099  WORKING-STORAGE SECTION.                                         EFTBD800
000995 77  PAN-VALET PICTURE X(24) VALUE '002EFTBD800  10/09/03'.       EFTBD800
00100                                                                   EFTBD800
00101  01  WRK-AREA.                                                    EFTBD800
00102      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +800.EFTBD800
00103                                                                   EFTBD800
00104      05  ABEND-MSG                   PIC  X(50).                  EFTBD800
00105                                                                   EFTBD800
00106      05  INCLUDE-REC-CNT             PIC S9(07)  COMP-3.          EFTBD800
00107                                                                   EFTBD800
00108      05  EXCLUDE-REC-CNT             PIC S9(07)  COMP-3.          EFTBD800
00109                                                                   EFTBD800
00110      05  PARM-REC-CNT                PIC S9(04)  COMP.            EFTBD800
00111                                                                   EFTBD800
00112      05  PARM-EOF-IND                PIC  X(01).                  EFTBD800
00113                                                                   EFTBD800
00114      05  ATLEAST-ONCE-REC-CNT        PIC S9(04)  COMP.            EFTBD800
00115                                                                   EFTBD800
00116      05  ATLEAST-ONCE-EOF-IND        PIC  X(01).                  EFTBD800
00117                                                                   EFTBD800
00118      05  NDX-1                       PIC S9(04)  COMP.            EFTBD800
00119                                                                   EFTBD800
00120      05  SYS-TIME.                                                EFTBD800
00121          10  SYS-H                   PIC  X(02).                  EFTBD800
00122          10  SYS-M                   PIC  X(02).                  EFTBD800
00123          10  SYS-S                   PIC  X(02).                  EFTBD800
00124          10  FILLER                  PIC  X(02).                  EFTBD800
00125                                                                   EFTBD800
00126      05  DISP-TIME.                                               EFTBD800
00127          10  DISP-H                  PIC  X(02).                  EFTBD800
00128          10  FILLER                  PIC  X(01)  VALUE '.'.       EFTBD800
00129          10  DISP-M                  PIC  X(02).                  EFTBD800
00130          10  FILLER                  PIC  X(01)  VALUE '.'.       EFTBD800
00131          10  DISP-S                  PIC  X(02).                  EFTBD800
00132      EJECT                                                        EFTBD800
00133      05  WRK-CONTROL-CNT             PIC S9(04)  COMP.            EFTBD800
00134                                                                   EFTBD800
00135      05  WRK-CONTROL-TYPE            PIC  X(03).                  EFTBD800
00136          88  WRK-INCLUDE-88                      VALUE 'INC'.     EFTBD800
00137          88  WRK-EXCLUDE-88                      VALUE 'EXC'.     EFTBD800
00138                                                                   EFTBD800
00139      05  WRK-CONTROL-REC-TYPE OCCURS 15 TIMES                     EFTBD800
00140                           INDEXED BY WRK-CONTROL-REC-IDX          EFTBD800
00141                                      PIC  X(03).                  EFTBD800
00142                                                                   EFTBD800
00143                                                                   EFTBD800
00144                                                                   EFTBD800
00145      05  WRK-SELECT-IND              PIC  X(01).                  EFTBD800
00146                                                                   EFTBD800
00147                                                                   EFTBD800
00148                                                                   EFTBD800
00149      05  WRK-ATLEAST-ONCE-CNT        PIC S9(04)  COMP.            EFTBD800
00150                                                                   EFTBD800
00151      05  WRK-ATLEAST-ONCE-OCCURS OCCURS 15 TIMES                  EFTBD800
00152                           INDEXED BY WRK-ATLEAST-ONCE-IDX.        EFTBD800
00153          10  WRK-ATLEAST-ONCE-REC-TYPE                            EFTBD800
00154                                      PIC  X(03).                  EFTBD800
00155          10  WRK-ATLEAST-ONCE-CALLED-IND                          EFTBD800
00156                                      PIC  X(01).                  EFTBD800
00157              88  WRK-ATLEAST-ONCE-CALLED-88      VALUE 'Y'.       EFTBD800
00158                                                                   EFTBD800
00159                                                                   EFTBD800
00160                                                                   EFTBD800
00161      05  HOLD-REC-TYPE               PIC  X(03)  VALUE ZEROES.    EFTBD800
00162      05  HOLD-REC-TYPE-9   REDEFINES   HOLD-REC-TYPE              EFTBD800
00163                                      PIC  9(03).                  EFTBD800
00164                                                                   EFTBD800
00165      05  HOLD-REC-CNT                PIC S9(07)  COMP-3.          EFTBD800
00166                                                                   EFTBD800
00167      05  PRINT-MODULE.                                            EFTBD800
00168          10  FILLER                  PIC  X(05)  VALUE 'EFTBR'.      CL**2
00169          10  PRINT-TYPE              PIC  X(03)  VALUE SPACES.    EFTBD800
00170      EJECT                                                        EFTBD800
00171  01  L001-LINK-AREA.                                              EFTBD800
00172  ++INCLUDE DTSIL001                                               EFTBD800
00173      EJECT                                                        EFTBD800
00174  01  L119-LINK-AREA.                                              EFTBD800
00175  ++INCLUDE DTSIL119                                               EFTBD800
00176      EJECT                                                        EFTBD800
00177  01  L931-LINK-AREA.                                              EFTBD800
00178  ++INCLUDE DTSIL931                                               EFTBD800
00179      EJECT                                                        EFTBD800
00180  01  L941-LINK-AREA.                                              EFTBD800
00181  ++INCLUDE DTSIL941                                               EFTBD800
00182      EJECT                                                        EFTBD800
00183  01  L980-LINK-AREA.                                              EFTBD800
00184  ++INCLUDE DTSIL980                                               EFTBD800
00185      EJECT                                                        EFTBD800
00186  01  RSK3-REC.                                                    EFTBD800
00187  ++INCLUDE DTSIRSK3                                               EFTBD800
00188      EJECT                                                        EFTBD800
00189  01  LRCM-LINK-AREA.                                              EFTBD800
00190  ++INCLUDE DTSILRCM                                               EFTBD800
00191      EJECT                                                        EFTBD800
00192  01  FSKL-REC.                                                    EFTBD800
00193  ++INCLUDE DTSIFSKL                                               EFTBD800
00194      EJECT                                                        EFTBD800
00195  PROCEDURE DIVISION.                                              EFTBD800
00196                                                                   EFTBD800
00197      PERFORM I0000-INITIATE THRU I0000-EXIT.                      EFTBD800
00198                                                                   EFTBD800
00199      PERFORM P0000-PROCESS THRU P0000-EXIT.                       EFTBD800
00200                                                                   EFTBD800
00201      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     EFTBD800
00202                                                                   EFTBD800
00203      GOBACK.                                                      EFTBD800
00204      EJECT                                                        EFTBD800
00205  I0000-INITIATE.                                                  EFTBD800
00206      PERFORM I1000-OPEN-FILES THRU I1000-EXIT.                    EFTBD800
00207                                                                   EFTBD800
00208      PERFORM I2000-PARM THRU I2000-EXIT.                          EFTBD800
00209                                                                   EFTBD800
00210      PERFORM I3000-ATLEAST-ONCE THRU I3000-EXIT.                  EFTBD800
00211                                                                   EFTBD800
00212      PERFORM I4000-INIT-LRCM THRU I4000-EXIT.                     EFTBD800
00213  I0000-EXIT.                                                      EFTBD800
00214      EXIT.                                                        EFTBD800
00215                                                                   EFTBD800
00216                                                                   EFTBD800
00217                                                                   EFTBD800
00218  I1000-OPEN-FILES.                                                EFTBD800
00219      SET L931-OPEN-READ-88 TO TRUE.                               EFTBD800
00220                                                                   EFTBD800
00221      PERFORM S931-REF-IO THRU S931-EXIT.                          EFTBD800
00222                                                                   EFTBD800
00223      SET L941-OPEN-READ-88 TO TRUE.                               EFTBD800
00224                                                                   EFTBD800
00225      PERFORM S941-RPT-I THRU S941-EXIT.                           EFTBD800
00226  I1000-EXIT.                                                      EFTBD800
00227      EXIT.                                                        EFTBD800
00228                                                                   EFTBD800
00229                                                                   EFTBD800
00230                                                                   EFTBD800
00231  I2000-PARM.                                                      EFTBD800
00232      OPEN INPUT PARM-FILE.                                        EFTBD800
00233                                                                   EFTBD800
00234      MOVE 'N' TO PARM-EOF-IND.                                    EFTBD800
00235                                                                   EFTBD800
00236      MOVE +0 TO PARM-REC-CNT.                                     EFTBD800
00237                                                                   EFTBD800
00238      DISPLAY ' '.                                                 EFTBD800
00239                                                                   EFTBD800
00240      DISPLAY '*** EFTBD800 PARAMETERS'.                              CL**2
00241                                                                   EFTBD800
00242      PERFORM I2100-READ-PARM THRU I2100-EXIT                      EFTBD800
00243         UNTIL PARM-EOF-IND = 'Y'.                                 EFTBD800
00244                                                                   EFTBD800
00245      IF PARM-REC-CNT = +0                                         EFTBD800
00246          SET WRK-EXCLUDE-88 TO TRUE                               EFTBD800
00247          MOVE +0 TO WRK-CONTROL-CNT                               EFTBD800
00248          DISPLAY '            (NONE)'                             EFTBD800
00249      ELSE                                                         EFTBD800
00250      IF PARM-REC-CNT > +1                                         EFTBD800
00251          MOVE 'NO MORE THAN ONE PARM RECORD ALLOWED'              EFTBD800
00252             TO ABEND-MSG                                          EFTBD800
00253          PERFORM S999-ABEND THRU S999-EXIT.                       EFTBD800
00254                                                                   EFTBD800
00255      DISPLAY ' '.                                                 EFTBD800
00256                                                                   EFTBD800
00257      CLOSE PARM-FILE.                                             EFTBD800
00258  I2000-EXIT.                                                      EFTBD800
00259      EXIT.                                                        EFTBD800
00260                                                                   EFTBD800
00261                                                                   EFTBD800
00262                                                                   EFTBD800
00263  I2100-READ-PARM.                                                 EFTBD800
00264      READ PARM-FILE                                               EFTBD800
00265         AT END                                                    EFTBD800
00266             MOVE 'Y' TO PARM-EOF-IND                              EFTBD800
00267             GO TO I2100-EXIT.                                     EFTBD800
00268                                                                   EFTBD800
00269      DISPLAY '*** ' PARM-REC.                                     EFTBD800
00270                                                                   EFTBD800
00271      ADD +1 TO PARM-REC-CNT.                                      EFTBD800
00272                                                                   EFTBD800
00273      IF PARM-MOD-NAME NOT = 'EFTBD800'                               CL**2
00274          MOVE 'INVALID PARM MODULE NAME' TO ABEND-MSG             EFTBD800
00275          PERFORM S999-ABEND THRU S999-EXIT.                       EFTBD800
00276                                                                   EFTBD800
00277      MOVE PARM-CONTROL-TYPE TO WRK-CONTROL-TYPE.                  EFTBD800
00278                                                                   EFTBD800
00279      IF WRK-INCLUDE-88 OR WRK-EXCLUDE-88                          EFTBD800
00280          NEXT SENTENCE                                            EFTBD800
00281      ELSE                                                         EFTBD800
00282          MOVE 'INVALID PARM CONTROL TYPE' TO ABEND-MSG            EFTBD800
00283          PERFORM S999-ABEND THRU S999-EXIT.                       EFTBD800
00284                                                                   EFTBD800
00285      MOVE +0 TO WRK-CONTROL-CNT.                                  EFTBD800
00286                                                                   EFTBD800
00287      PERFORM I2110-RPT-TYPE-LOOP THRU I2110-EXIT                  EFTBD800
00288         VARYING PARM-RPT-IDX FROM 1 BY 1                          EFTBD800
00289         UNTIL PARM-RPT-IDX > 15.                                  EFTBD800
00290                                                                   EFTBD800
00291      IF (WRK-INCLUDE-88) AND (WRK-CONTROL-CNT = +0)               EFTBD800
00292          MOVE 'AT LEAST ONE PARM REC TYPE REQUIRED FOR INCLUDING' EFTBD800
00293             TO ABEND-MSG                                          EFTBD800
00294          PERFORM S999-ABEND THRU S999-EXIT.                       EFTBD800
00295  I2100-EXIT.                                                      EFTBD800
00296      EXIT.                                                        EFTBD800
00297                                                                   EFTBD800
00298                                                                   EFTBD800
00299                                                                   EFTBD800
00300  I2110-RPT-TYPE-LOOP.                                             EFTBD800
00301      IF PARM-RPT-TYPE (PARM-RPT-IDX) = SPACES                     EFTBD800
00302          NEXT SENTENCE                                            EFTBD800
00303      ELSE                                                         EFTBD800
00304          ADD +1 TO WRK-CONTROL-CNT                                EFTBD800
00305          MOVE PARM-RPT-TYPE (PARM-RPT-IDX)                        EFTBD800
00306             TO WRK-CONTROL-REC-TYPE (WRK-CONTROL-CNT).            EFTBD800
00307  I2110-EXIT.                                                      EFTBD800
00308      EXIT.                                                        EFTBD800
00309      EJECT                                                        EFTBD800
00310  I3000-ATLEAST-ONCE.                                              EFTBD800
00311      OPEN INPUT ATLEAST-ONCE-FILE.                                EFTBD800
00312                                                                   EFTBD800
00313      MOVE 'N' TO ATLEAST-ONCE-EOF-IND.                            EFTBD800
00314                                                                   EFTBD800
00315      MOVE +0 TO ATLEAST-ONCE-REC-CNT.                             EFTBD800
00316                                                                   EFTBD800
00317      DISPLAY ' '.                                                 EFTBD800
00318                                                                   EFTBD800
00319      DISPLAY '*** EFTBD800 AT LEAST ONCE PARAMETERS'.                CL**2
00320                                                                   EFTBD800
00321      PERFORM I3100-READ-ATLEAST-ONCE-FILE THRU I3100-EXIT         EFTBD800
00322         UNTIL ATLEAST-ONCE-EOF-IND = 'Y'.                         EFTBD800
00323                                                                   EFTBD800
00324      IF ATLEAST-ONCE-REC-CNT = +0                                 EFTBD800
00325          MOVE +0 TO WRK-ATLEAST-ONCE-CNT                          EFTBD800
00326          DISPLAY '            (NONE)'                             EFTBD800
00327      ELSE                                                         EFTBD800
00328      IF ATLEAST-ONCE-REC-CNT > +1                                 EFTBD800
00329          MOVE 'NO MORE THAN ONE AT LEAST ONCE RECORD ALLOWED'     EFTBD800
00330             TO ABEND-MSG                                          EFTBD800
00331          PERFORM S999-ABEND THRU S999-EXIT.                       EFTBD800
00332                                                                   EFTBD800
00333      DISPLAY ' '.                                                 EFTBD800
00334                                                                   EFTBD800
00335      CLOSE ATLEAST-ONCE-FILE.                                     EFTBD800
00336  I3000-EXIT.                                                      EFTBD800
00337      EXIT.                                                        EFTBD800
00338                                                                   EFTBD800
00339                                                                   EFTBD800
00340                                                                   EFTBD800
00341  I3100-READ-ATLEAST-ONCE-FILE.                                    EFTBD800
00342      READ ATLEAST-ONCE-FILE                                       EFTBD800
00343         AT END                                                    EFTBD800
00344             MOVE 'Y' TO ATLEAST-ONCE-EOF-IND                      EFTBD800
00345             GO TO I3100-EXIT.                                     EFTBD800
00346                                                                   EFTBD800
00347      DISPLAY '*** ' ATLEAST-ONCE-REC.                             EFTBD800
00348                                                                   EFTBD800
00349      ADD +1 TO ATLEAST-ONCE-REC-CNT.                              EFTBD800
00350                                                                   EFTBD800
00351      IF ATLEAST-ONCE-MOD-NAME NOT = 'EFTBD800'                       CL**2
00352          MOVE 'INVALID AT LEAST ONCE MODULE NAME' TO ABEND-MSG    EFTBD800
00353          PERFORM S999-ABEND THRU S999-EXIT.                       EFTBD800
00354                                                                   EFTBD800
00355      MOVE +0 TO WRK-ATLEAST-ONCE-CNT.                             EFTBD800
00356                                                                   EFTBD800
00357      PERFORM I3110-RPT-TYPE-LOOP                                  EFTBD800
00358         THRU I3110-EXIT                                           EFTBD800
00359           VARYING ATLEAST-ONCE-RPT-IDX FROM 1 BY 1                EFTBD800
00360             UNTIL ATLEAST-ONCE-RPT-IDX > 15.                      EFTBD800
00361  I3100-EXIT.                                                      EFTBD800
00362      EXIT.                                                        EFTBD800
00363                                                                   EFTBD800
00364                                                                   EFTBD800
00365                                                                   EFTBD800
00366  I3110-RPT-TYPE-LOOP.                                             EFTBD800
00367      IF ATLEAST-ONCE-RPT-TYPE (ATLEAST-ONCE-RPT-IDX) NOT = SPACES EFTBD800
00368          ADD +1 TO WRK-ATLEAST-ONCE-CNT                           EFTBD800
00369          MOVE ATLEAST-ONCE-RPT-TYPE (ATLEAST-ONCE-RPT-IDX)        EFTBD800
00370            TO WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-CNT)    EFTBD800
00371          MOVE 'N'                                                 EFTBD800
00372            TO WRK-ATLEAST-ONCE-CALLED-IND (WRK-ATLEAST-ONCE-CNT). EFTBD800
00373  I3110-EXIT.                                                      EFTBD800
00374      EXIT.                                                        EFTBD800
00375      EJECT                                                        EFTBD800
00376  I4000-INIT-LRCM.                                                 EFTBD800
00377      MOVE SPACES TO LRCM-LINK-AREA.                               EFTBD800
00378                                                                   EFTBD800
00379      PERFORM I4010-INIT-L980 THRU I4010-EXIT                      EFTBD800
00380          VARYING NDX-1 FROM 1 BY 1                                EFTBD800
00381              UNTIL NDX-1 > 999.                                   EFTBD800
00382                                                                   EFTBD800
00383      SET L001-FROM-FED-6 TO TRUE.                                 EFTBD800
00384                                                                   EFTBD800
00385      ACCEPT L001-FED-6-DATE-9 FROM DATE.                          EFTBD800
00386                                                                   EFTBD800
00387      PERFORM S001-CONVERT-DATE THRU S001-EXIT.                    EFTBD800
00388                                                                   EFTBD800
00389      MOVE L001-SLASH-DATE TO LRCM-SYS-DATE.                       EFTBD800
00390                                                                   EFTBD800
00391      MOVE L001-SLASH-8-DATE TO LRCM-SYS-8-DATE.                   EFTBD800
00392                                                                   EFTBD800
00393                                                                   EFTBD800
00394      SET L119-REQ-MIXED-88 TO TRUE.                               EFTBD800
00395                                                                   EFTBD800
00396      SET L119-REQ-NO-UNIT-88 TO TRUE.                             EFTBD800
00397                                                                   EFTBD800
00398      PERFORM S119-AGENCY-FACTS THRU S119-EXIT.                    EFTBD800
00399                                                                   EFTBD800
00400      MOVE L119-UC-OFFICE-NAME TO LRCM-DEFAULT-NAME.               EFTBD800
00401                                                                   EFTBD800
00402      MOVE L119-UC-OFFICE-VOICE TO LRCM-DEFAULT-VOICE.             EFTBD800
00403                                                                   EFTBD800
00404                                                                   EFTBD800
00405      ACCEPT SYS-TIME FROM TIME.                                   EFTBD800
00406                                                                   EFTBD800
00407      MOVE SYS-H TO DISP-H.                                        EFTBD800
00408                                                                   EFTBD800
00409      MOVE SYS-M TO DISP-M.                                        EFTBD800
00410                                                                   EFTBD800
00411      MOVE SYS-S TO DISP-S.                                        EFTBD800
00412                                                                   EFTBD800
00413      MOVE DISP-TIME TO LRCM-SYS-TIME.                             EFTBD800
00414                                                                   EFTBD800
00415      MOVE +19924 TO LRCM-PICKUP-YRQ.                              EFTBD800
00416                                                                   EFTBD800
00417                                                                   EFTBD800
00418      MOVE '               DISTRICT OF COLUMBIA               '    EFTBD800
00419         TO LRCM-AGY-NAME-LINE1.                                   EFTBD800
00420                                                                   EFTBD800
00421      MOVE '                   TAX DIVISION                   '    EFTBD800
00422         TO LRCM-AGY-NAME-LINE2.                                   EFTBD800
00423  I4000-EXIT.                                                      EFTBD800
00424      EXIT.                                                        EFTBD800
00425  I4010-INIT-L980.                                                 EFTBD800
00426      MOVE ZERO TO L980-REC-CNT (NDX-1).                           EFTBD800
00427  I4010-EXIT.                                                      EFTBD800
00428      EXIT.                                                        EFTBD800
00429      EJECT                                                        EFTBD800
00430  P0000-PROCESS.                                                   EFTBD800
00431      MOVE +0 TO INCLUDE-REC-CNT                                   EFTBD800
00432                 EXCLUDE-REC-CNT.                                  EFTBD800
00433                                                                   EFTBD800
00434      DISPLAY ' '.                                                 EFTBD800
00435                                                                   EFTBD800
00436      DISPLAY '*** EFTBD800 STATISTICS'.                              CL**2
00437                                                                   EFTBD800
00438      SET L941-READ-NEXT-88 TO TRUE.                               EFTBD800
00439                                                                   EFTBD800
00440      PERFORM S941-RPT-I THRU S941-EXIT.                           EFTBD800
00441                                                                   EFTBD800
00442      IF L941-NO-REC-88                                            EFTBD800
00443          GO TO P0000-EXIT.                                        EFTBD800
00444                                                                   EFTBD800
00445                                                                   EFTBD800
00446      PERFORM P1000-PROCESS-RETURN THRU P1000-EXIT                 EFTBD800
00447         UNTIL L941-NO-REC-88.                                     EFTBD800
00448                                                                   EFTBD800
00449                                                                   EFTBD800
00450      IF WRK-SELECT-IND = 'I'                                      EFTBD800
00451          PERFORM P1500-TERM-REC-TYPE THRU P1500-EXIT.             EFTBD800
00452  P0000-EXIT.                                                      EFTBD800
00453      EXIT.                                                        EFTBD800
00454                                                                   EFTBD800
00455                                                                   EFTBD800
00456                                                                   EFTBD800
00457  P1000-PROCESS-RETURN.                                            EFTBD800
00458      IF RSK3-REC-TYPE NOT = HOLD-REC-TYPE                         EFTBD800
00459          IF HOLD-REC-TYPE = SPACES                                EFTBD800
00460              PERFORM P1100-INIT-REC-TYPE THRU P1100-EXIT          EFTBD800
00461          ELSE                                                     EFTBD800
00462              IF WRK-SELECT-IND = 'I'                              EFTBD800
00463                  PERFORM P1500-TERM-REC-TYPE THRU P1500-EXIT      EFTBD800
00464              ELSE                                                 EFTBD800
00465                  CONTINUE                                         EFTBD800
00466              END-IF                                               EFTBD800
00467              PERFORM P1100-INIT-REC-TYPE THRU P1100-EXIT.         EFTBD800
00468                                                                   EFTBD800
00469      IF WRK-SELECT-IND = 'I'                                      EFTBD800
00470          ADD +1 TO INCLUDE-REC-CNT                                EFTBD800
00471                    HOLD-REC-CNT                                   EFTBD800
00472          PERFORM S1000-CALL-R-MOD THRU S1000-EXIT                 EFTBD800
00473      ELSE                                                         EFTBD800
00474          ADD +1 TO EXCLUDE-REC-CNT.                               EFTBD800
00475                                                                   EFTBD800
00476      SET L941-READ-NEXT-88 TO TRUE.                               EFTBD800
00477                                                                   EFTBD800
00478      PERFORM S941-RPT-I THRU S941-EXIT.                           EFTBD800
00479  P1000-EXIT.                                                      EFTBD800
00480      EXIT.                                                        EFTBD800
00481      EJECT                                                        EFTBD800
00482  P1100-INIT-REC-TYPE.                                             EFTBD800
00483      MOVE RSK3-REC-TYPE TO HOLD-REC-TYPE.                         EFTBD800
00484                                                                   EFTBD800
00485      IF WRK-EXCLUDE-88                                            EFTBD800
00486          IF WRK-CONTROL-CNT = +0                                  EFTBD800
00487              MOVE 'I' TO WRK-SELECT-IND                           EFTBD800
00488          ELSE                                                     EFTBD800
00489              MOVE 'I' TO WRK-SELECT-IND                           EFTBD800
00490              PERFORM P1110-EXCLUDE THRU P1110-EXIT                EFTBD800
00491                 VARYING WRK-CONTROL-REC-IDX FROM 1 BY 1           EFTBD800
00492                 UNTIL (WRK-CONTROL-REC-IDX > WRK-CONTROL-CNT)     EFTBD800
00493                            OR                                     EFTBD800
00494                       (WRK-SELECT-IND = 'E')                      EFTBD800
00495      ELSE                                                         EFTBD800
00496          MOVE 'E' TO WRK-SELECT-IND                               EFTBD800
00497          PERFORM P1120-INCLUDE THRU P1120-EXIT                    EFTBD800
00498             VARYING WRK-CONTROL-REC-IDX FROM 1 BY 1               EFTBD800
00499             UNTIL (WRK-CONTROL-REC-IDX > WRK-CONTROL-CNT)         EFTBD800
00500                          OR                                       EFTBD800
00501                   (WRK-SELECT-IND = 'I').                         EFTBD800
00502                                                                   EFTBD800
00503      IF WRK-SELECT-IND = 'E'                                      EFTBD800
00504          GO TO P1100-EXIT.                                        EFTBD800
00505                                                                   EFTBD800
00506      IF WRK-ATLEAST-ONCE-CNT = +0                                 EFTBD800
00507          NEXT SENTENCE                                            EFTBD800
00508      ELSE                                                         EFTBD800
00509          PERFORM P1130-UPDT-ATLEAST-ONCE-CALLED THRU P1130-EXIT   EFTBD800
00510             VARYING WRK-ATLEAST-ONCE-IDX FROM 1 BY 1              EFTBD800
00511             UNTIL (WRK-ATLEAST-ONCE-IDX > WRK-ATLEAST-ONCE-CNT).  EFTBD800
00512                                                                   EFTBD800
00513      MOVE HOLD-REC-TYPE TO PRINT-TYPE.                            EFTBD800
00514                                                                   EFTBD800
00515      MOVE +0 TO HOLD-REC-CNT.                                     EFTBD800
00516                                                                   EFTBD800
00517      MOVE 'N' TO LRCM-EOR-IND.                                    EFTBD800
00518  P1100-EXIT.                                                      EFTBD800
00519      EXIT.                                                        EFTBD800
00520                                                                   EFTBD800
00521                                                                   EFTBD800
00522                                                                   EFTBD800
00523  P1110-EXCLUDE.                                                   EFTBD800
00524      IF RSK3-REC-TYPE = WRK-CONTROL-REC-TYPE (WRK-CONTROL-REC-IDX)EFTBD800
00525          MOVE 'E' TO WRK-SELECT-IND.                              EFTBD800
00526  P1110-EXIT.                                                      EFTBD800
00527      EXIT.                                                        EFTBD800
00528                                                                   EFTBD800
00529                                                                   EFTBD800
00530                                                                   EFTBD800
00531  P1120-INCLUDE.                                                   EFTBD800
00532      IF RSK3-REC-TYPE = WRK-CONTROL-REC-TYPE (WRK-CONTROL-REC-IDX)EFTBD800
00533          MOVE 'I' TO WRK-SELECT-IND.                              EFTBD800
00534  P1120-EXIT.                                                      EFTBD800
00535      EXIT.                                                        EFTBD800
00536                                                                   EFTBD800
00537                                                                   EFTBD800
00538                                                                   EFTBD800
00539  P1130-UPDT-ATLEAST-ONCE-CALLED.                                  EFTBD800
00540      IF RSK3-REC-TYPE                                             EFTBD800
00541             = WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-IDX)    EFTBD800
00542          MOVE 'Y'                                                 EFTBD800
00543             TO WRK-ATLEAST-ONCE-CALLED-IND (WRK-ATLEAST-ONCE-IDX) EFTBD800
00544          SET WRK-ATLEAST-ONCE-IDX TO WRK-ATLEAST-ONCE-CNT.        EFTBD800
00545  P1130-EXIT.                                                      EFTBD800
00546      EXIT.                                                        EFTBD800
00547      EJECT                                                        EFTBD800
00548  P1500-TERM-REC-TYPE.                                             EFTBD800
00549      MOVE 'Y' TO LRCM-EOR-IND.                                    EFTBD800
00550                                                                   EFTBD800
00551      PERFORM S1000-CALL-R-MOD THRU S1000-EXIT.                    EFTBD800
00552                                                                   EFTBD800
00553      DISPLAY HOLD-REC-CNT                                         EFTBD800
00554              ' RECORD TYPE '                                      EFTBD800
00555              HOLD-REC-TYPE                                        EFTBD800
00556              ' RECORDS PROCESSED'.                                EFTBD800
00557                                                                   EFTBD800
00558      MOVE HOLD-REC-CNT TO L980-REC-CNT (HOLD-REC-TYPE-9).         EFTBD800
00559                                                                   EFTBD800
00560      CANCEL PRINT-MODULE.                                         EFTBD800
00561  P1500-EXIT.                                                      EFTBD800
00562      EXIT.                                                        EFTBD800
00563      EJECT                                                        EFTBD800
00564  T0000-TERMINATE.                                                 EFTBD800
00565      DISPLAY ' '.                                                 EFTBD800
00566                                                                   EFTBD800
00567      DISPLAY '*** EFTBD800 TERMINATION STATISTICS'.                  CL**2
00568                                                                   EFTBD800
00569      DISPLAY INCLUDE-REC-CNT                                      EFTBD800
00570              ' RECORDS INCLUDED'.                                 EFTBD800
00571                                                                   EFTBD800
00572      DISPLAY EXCLUDE-REC-CNT                                      EFTBD800
00573              ' RECORDS EXCLUDED'.                                 EFTBD800
00574                                                                   EFTBD800
00575                                                                   EFTBD800
00576      IF WRK-ATLEAST-ONCE-CNT = +0                                 EFTBD800
00577          NEXT SENTENCE                                            EFTBD800
00578      ELSE                                                         EFTBD800
00579          PERFORM T1000-CHK-ATLEAST-ONCE-CALLED THRU T1000-EXIT    EFTBD800
00580             VARYING WRK-ATLEAST-ONCE-IDX FROM 1 BY 1              EFTBD800
00581             UNTIL (WRK-ATLEAST-ONCE-IDX > WRK-ATLEAST-ONCE-CNT).  EFTBD800
00582                                                                   EFTBD800
00583                                                                   EFTBD800
00584      SET L931-CLOSE-88 TO TRUE.                                   EFTBD800
00585                                                                   EFTBD800
00586      PERFORM S931-REF-IO THRU S931-EXIT.                          EFTBD800
00587                                                                   EFTBD800
00588      SET L941-CLOSE-88 TO TRUE.                                   EFTBD800
00589                                                                   EFTBD800
00590      PERFORM S941-RPT-I THRU S941-EXIT.                           EFTBD800
00591                                                                   EFTBD800
00592      PERFORM S980-CTRL-RPT-O THRU S980-EXIT.                      EFTBD800
00593  T0000-EXIT.                                                      EFTBD800
00594      EXIT.                                                        EFTBD800
00595                                                                   EFTBD800
00596                                                                   EFTBD800
00597  T1000-CHK-ATLEAST-ONCE-CALLED.                                   EFTBD800
00598      IF WRK-ATLEAST-ONCE-CALLED-88 (WRK-ATLEAST-ONCE-IDX)         EFTBD800
00599          NEXT SENTENCE                                            EFTBD800
00600      ELSE                                                         EFTBD800
00601          MOVE WRK-ATLEAST-ONCE-REC-TYPE (WRK-ATLEAST-ONCE-IDX)    EFTBD800
00602             TO PRINT-TYPE                                         EFTBD800
00603          MOVE 'Y' TO LRCM-EOR-IND                                 EFTBD800
00604          PERFORM S1000-CALL-R-MOD THRU S1000-EXIT                 EFTBD800
00605          CANCEL PRINT-MODULE.                                     EFTBD800
00606  T1000-EXIT.                                                      EFTBD800
00607      EXIT.                                                        EFTBD800
00608      EJECT                                                        EFTBD800
00609  S1000-CALL-R-MOD.                                                EFTBD800
00610      CALL PRINT-MODULE USING LRCM-LINK-AREA                       EFTBD800
00611                              RSK3-REC.                            EFTBD800
00612  S1000-EXIT.                                                      EFTBD800
00613      EXIT.                                                        EFTBD800
00614      EJECT                                                        EFTBD800
00615  S001-CONVERT-DATE.                                               EFTBD800
00616      CALL 'DTSBU001' USING L001-LINK-AREA.                        EFTBD800
00617  S001-EXIT.                                                       EFTBD800
00618      EXIT.                                                        EFTBD800
00619                                                                   EFTBD800
00620                                                                   EFTBD800
00621  S119-AGENCY-FACTS.                                               EFTBD800
00622      CALL 'DTSBU119' USING L119-LINK-AREA.                        EFTBD800
00623  S119-EXIT.                                                       EFTBD800
00624      EXIT.                                                        EFTBD800
00625                                                                   EFTBD800
00626                                                                   EFTBD800
00627  S931-REF-IO.                                                     EFTBD800
00628      CALL 'DTSBU931' USING L931-LINK-AREA                         EFTBD800
00629                            FSKL-REC.                              EFTBD800
00630  S931-EXIT.                                                       EFTBD800
00631      EXIT.                                                        EFTBD800
00632                                                                   EFTBD800
00633                                                                   EFTBD800
00634  S941-RPT-I.                                                      EFTBD800
00635      CALL 'DTSBU941' USING L941-LINK-AREA                         EFTBD800
00636                            RSK3-REC.                              EFTBD800
00637  S941-EXIT.                                                       EFTBD800
00638      EXIT.                                                        EFTBD800
00639                                                                   EFTBD800
00640                                                                   EFTBD800
00641  S980-CTRL-RPT-O.                                                 EFTBD800
00642      CALL 'DTSBR980' USING LRCM-LINK-AREA,                        EFTBD800
00643                            L980-LINK-AREA.                        EFTBD800
00644  S980-EXIT.                                                       EFTBD800
00645      EXIT.                                                        EFTBD800
00646                                                                   EFTBD800
00647                                                                   EFTBD800
00648  S999-ABEND.                                                      EFTBD800
00649      DISPLAY '*** EFTBD800 ABENDING - ' ABEND-MSG.                   CL**2
00650                                                                   EFTBD800
00651      CALL 'DTSBU999' USING WRK-ABEND-CD.                          EFTBD800
00652  S999-EXIT.                                                       EFTBD800
00653      EXIT.                                                        EFTBD800
