00001  IDENTIFICATION DIVISION.                                         03/18/04
00002  PROGRAM-ID.             EFTBR120.                                EFTBR120
00003  AUTHOR.                 NORTHROP GRUMMAN.                           LV131
00004  DATE-WRITTEN.           JULY 2003.                                  CL*58
00005  DATE-COMPILED.                                                   EFTBR120
00006                                                                   EFTBR120
00007 *****                                                             EFTBR120
00008 *                                                                 EFTBR120
00009 *    CALLING SEQUENCE:  EFTBD120 WHICH UPDATES EFTIR120              CL101
00010 *                       EFTBR120 READS EFTIR120 RECORDS.             CL*61
00011 *                                                                 EFTBR120
00012 *    FUNCTION:  WEB EMPLOYER STATUS REPORT.                          CL*60
00013 *                                                                 EFTBR120
00014 *                                                                 EFTBR120
00015 *    MODIFICATION HISTORY:                                        EFTBR120
00016 *                                                                 EFTBR120
00017 * 07/30/03 INITIAL DEVELOPMENT                                       CL*58
00018 *          WORK ORDER:                    AUTHOR OF CHANGE - RW1     CL*59
00019 *                                                                 EFTBR120
00020 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  EFTBR120
00021 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  EFTBR120
00022 *          WORK ORDER: #****              AUTHOR OF CHANGE - XXX     CL*59
00023 *                                                                 EFTBR120
00024 *                                                                 EFTBR120
00025 *    DESCRIPTION:                                                 EFTBR120
00026 *                                                                 EFTBR120
00027 *        THIS MODULE REPORTS THE EMPLOYER STATUS CHANGES ON THE      CL*50
00028 *        SALE DATE, LAST WAGES PAID DATE, AND STATUS CHANGE DE-      CL*63
00029 *        SCRIPTION ONLY.                                             CL*63
00030 *                                                                 EFTBR120
00031 *                                                                 EFTBR120
00032 *    RECORDS READ:                                                EFTBR120
00033 *                                                                 EFTBR120
00034 *        NONE.                                                    EFTBR120
00035 *                                                                 EFTBR120
00036 *                                                                 EFTBR120
00037 *    PRINTED OUTPUTS:                                             EFTBR120
00038 *                                                                 EFTBR120
00039 *        120R1  EMPLOYER WEB STATUS CHANGES REPORT                   CL*63
00040 *                                                                 EFTBR120
00041 *                                                                 EFTBR120
00042 *    RECORDS WRITTEN:                                             EFTBR120
00043 *                                                                 EFTBR120
00044 *        NONE.                                                    EFTBR120
00045 *                                                                 EFTBR120
00046 *                                                                 EFTBR120
00047 *    MODULES CALLED:                                              EFTBR120
00048 *                                                                 EFTBR120
00049 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     EFTBR120
00050 *                                                                 EFTBR120
00051 *                                                                 EFTBR120
00052 *****                                                             EFTBR120
00053      SKIP3                                                           CL*58
00054  ENVIRONMENT DIVISION.                                            EFTBR120
00055                                                                   EFTBR120
00056  CONFIGURATION SECTION.                                           EFTBR120
00057  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               EFTBR120
00058                                                                   EFTBR120
00059  INPUT-OUTPUT SECTION.                                            EFTBR120
00060                                                                   EFTBR120
00061  FILE-CONTROL.                                                    EFTBR120
00062      SELECT PRT-FILE ASSIGN TO RPT120R1.                             CL*64
00063                                                                   EFTBR120
00064  DATA DIVISION.                                                   EFTBR120
00065                                                                   EFTBR120
00066  FILE SECTION.                                                    EFTBR120
00067                                                                   EFTBR120
00068  FD  PRT-FILE                                                        CL*51
00069      RECORDING MODE IS F.                                         EFTBR120
00070  01  PRT-RECORD              PIC X(133).                             CL*51
00071      EJECT                                                        EFTBR120
00072                                                                      CL*20
00073  WORKING-STORAGE SECTION.                                         EFTBR120
000735 77  PAN-VALET PICTURE X(24) VALUE '131EFTBR120  03/18/04'.       EFTBR120
00074                                                                   EFTBR120
00075  01  WRK-AREA.                                                    EFTBR120
00076      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +120.   CL*65
00077      05  WRK-ABEND-MSG               PIC  X(60)  VALUE SPACES.       CL*24
00078      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.          CL*24
00079      05  WS-NUMBER-ONE               PIC S9(05)  COMP-3 VALUE +0.    CL*19
00080      05  WS-FEIN                     PIC  9(09)  VALUE 0.            CL*74
00081                                                                   EFTBR120
00082      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.  EFTBR120
00083      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.  EFTBR120
00084      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  EFTBR120
00085      05  WS-FOOT-CNT                 PIC S9(05) COMP-3 VALUE +0.     CL*58
00086                                                                      CL**3
00087      05  WRK-START-YRQ               PIC  9(05).                     CL**3
00088      05  FILLER REDEFINES WRK-START-YRQ.                             CL**3
00089          10  WRK-START-YRQ-Y         PIC  X(04).                     CL*31
00090          10  WRK-START-YRQ-Q         PIC  X(01).                     CL*31
00091                                                                      CL**3
00092      05  WRK-EDIT-PHONE.                                             CL112
00093          10  WRK-LEFT-PARN           PIC X(01).                      CL115
00094          10  WRK-AREA-CODE           PIC X(03).                      CL112
00095          10  WRK-RIGHT-PARN          PIC X(01).                      CL117
00096          10  FILLER                  PIC X(01).                      CL117
00097          10  WRK-EXCHANGE            PIC X(03).                      CL112
00098          10  WRK-DASH                PIC X(01).                      CL115
00099          10  WRK-NUMBER              PIC X(04).                      CL112
00100          10  FILLER                  PIC X(01).                      CL126
00101          10  WRK-EXT                 PIC X(05).                      CL126
00102                                                                      CL112
00103      EJECT                                                        EFTBR120
00104  01  L001-LINK-AREA.                                              EFTBR120
00105  ++INCLUDE DTSIL001                                               EFTBR120
00106      EJECT                                                        EFTBR120
00107                                                                   EFTBR120
00108  01  HEADER-1.                                                    EFTBR120
00109      05  FILLER                   PIC X(01) VALUE SPACES.         EFTBR120
00110      05  FILLER                   PIC X(49) VALUE '120R1'.           CL*67
00111      05  FILLER                   PIC X(60) VALUE                 EFTBR120
00112          'DISTRICT OF COLUMBIA'.                                  EFTBR120
00113      05  FILLER                   PIC X(06) VALUE 'DATE:'.        EFTBR120
00114      05  HDR1-LRCM-SYS-DATE       PIC X(08).                      EFTBR120
00115                                                                      CL*23
00116  01  HEADER-2.                                                    EFTBR120
00117      05  FILLER                   PIC X(54) VALUE SPACES.         EFTBR120
00118      05  FILLER                   PIC X(56) VALUE                 EFTBR120
00119          'TAX DIVISION'.                                          EFTBR120
00120      05  FILLER                   PIC X(06) VALUE 'TIME:'.        EFTBR120
00121      05  HDR2-LRCM-SYS-TIME       PIC X(08).                      EFTBR120
00122                                                                   EFTBR120
00123  01  HEADER-3.                                                    EFTBR120
00124      05  FILLER                   PIC X(01) VALUE SPACES.         EFTBR120
00125      05  FILLER                   PIC X(41) VALUE                    CL*56
00126          'ROUTE TO:  TAX CHIEF'.                                  EFTBR120
00127      05  HDR3-LITERAL             PIC X(60) VALUE                    CL*56
00128          '      WEB STATUS CHANGED REPORT      '.                    CL102
00129      05  FILLER                   PIC X(08) VALUE SPACES.            CL*56
00130      05  FILLER                   PIC X(06) VALUE 'PAGE:'.        EFTBR120
00131      05  HDR3-PAGE                PIC ZZ,ZZ9.                     EFTBR120
00132                                                                      CL*20
00133  01  HEADER-4.                                                    EFTBR120
00134      05  FILLER                   PIC X(01)  VALUE SPACES.        EFTBR120
00135      05  FILLER                   PIC X(132) VALUE SPACES.        EFTBR120
00136                                                                   EFTBR120
00137  01  HEADER-5.                                                       CL**5
00138      05  FILLER                   PIC X(01)  VALUE SPACES.        EFTBR120
00139      05  FILLER                   PIC X(10)  VALUE SPACES.           CL106
00140      05  FILLER                   PIC X(11)  VALUE                   CL106
00141                       ' NEW FEIN/ '.                                 CL106
00142      05  FILLER                   PIC X(29)  VALUE SPACES.           CL107
00143      05  FILLER                   PIC X(10)  VALUE                   CL*56
00144                       'LAST WAGES'.                                  CL*56
00145      05  FILLER                   PIC X(02)  VALUE SPACES.           CL100
00146      05  FILLER                   PIC X(08)  VALUE                   CL100
00147                       'BUSINESS'.                                    CL100
00148      05  FILLER                   PIC X(01)  VALUE SPACE.            CL111
00149      05  FILLER                   PIC X(19)  VALUE                   CL122
00150                       '------CONTACT------'.                         CL122
00151      05  FILLER                   PIC X(02)  VALUE SPACE.            CL124
00152      05  FILLER                   PIC X(40)  VALUE SPACES.           CL130
00153                                                                      CL*56
00154  01  HEADER-6.                                                       CL**5
00155      05  FILLER                   PIC X(01)  VALUE SPACES.        EFTBR120
00156      05  FILLER                   PIC X(02)  VALUE SPACES.           CL*70
00157      05  FILLER                   PIC X(06)  VALUE                   CL*56
00158                       'EMP NO'.                                      CL*56
00159      05  FILLER                   PIC X(02)  VALUE SPACES.           CL106
00160      05  FILLER                   PIC X(11)  VALUE                   CL106
00161                       'ENTITY NAME'.                                 CL106
00162      05  FILLER                   PIC X(01)  VALUE SPACES.           CL106
00163      05  FILLER                   PIC X(13)  VALUE                   CL*86
00164                       ' TRACE NUMBER'.                               CL*93
00165      05  FILLER                   PIC X(03)  VALUE SPACES.           CL*90
00166      05  FILLER                   PIC X(09)  VALUE                   CL*56
00167                       'SALE DATE'.                                   CL*56
00168      05  FILLER                   PIC X(03)  VALUE SPACES.           CL*70
00169      05  FILLER                   PIC X(09)  VALUE                   CL*56
00170                       'PAID DATE'.                                   CL*58
00171      05  FILLER                   PIC X(03)  VALUE SPACES.           CL*97
00172      05  FILLER                   PIC X(07)  VALUE                   CL*96
00173                       'ADDRESS'.                                     CL*96
00174      05  FILLER                   PIC X(06)  VALUE SPACES.           CL124
00175      05  FILLER                   PIC X(05)  VALUE                   CL121
00176                       'PHONE'.                                       CL106
00177      05  FILLER                   PIC X(01)  VALUE '/'.              CL106
00178      05  FILLER                   PIC X(04)  VALUE                   CL106
00179                       'NAME'.                                        CL106
00180      05  FILLER                   PIC X(07)  VALUE SPACES.           CL125
00181      05  FILLER                   PIC X(25)  VALUE                   CL130
00182                       'STATUS CHANGE DESCRIPTION'.                   CL130
00183      05  FILLER                   PIC X(18)  VALUE SPACES.           CL130
00184                                                                      CL*56
00185  01  SPACES-LINE.                                                    CL127
00186      05  FILLER                   PIC X(01)  VALUE SPACES.           CL*56
00187      05  FILLER                   PIC X(132) VALUE SPACES.           CL*56
00188                                                                      CL*56
00189  01  DETAIL-LINE-1.                                                  CL**5
00190      05  FILLER                  PIC  X(03)  VALUE SPACES.           CL*70
00191      05  WS-EMP-NO               PIC  999B999.                    EFTBR120
00192      05  FILLER                  PIC  X(02)  VALUE SPACES.           CL*71
00193      05  DTL1-FEIN.                                                  CL*86
00194          10  DTL1-FEIN2          PIC  X(02).                         CL*86
00195          10  WS-DASH             PIC  X(01).                         CL*95
00196          10  DTL1-FEIN7          PIC  X(07).                         CL*86
00197      05  FILLER                  PIC  X(02)  VALUE SPACES.           CL*86
00198      05  WS-TRACE-NO             PIC  9(13)  BLANK WHEN ZERO.        CL*94
00199      05  FILLER                  PIC  X(02)  VALUE SPACES.           CL*90
00200      05  WS-SALE-DATE            PIC  X(10).                         CL*66
00201      05  FILLER                  PIC  X(02)  VALUE SPACES.           CL*70
00202      05  WS-LAST-WAGES-PAID-DATE PIC  X(10).                         CL*66
00203      05  FILLER                  PIC  X(04)  VALUE SPACES.           CL*96
00204      05  WS-ADDRESS              PIC  X(03).                         CL*96
00205      05  FILLER                  PIC  X(04)  VALUE SPACES.           CL123
00206      05  WS-PHONE                PIC  X(20).                         CL127
00207      05  FILLER                  PIC  X(01)  VALUE SPACES.           CL129
00208      05  WS-STATUS-CHNG-DESC     PIC  X(40).                         CL126
00209                                                                      CL*52
00210  01  DETAIL-LINE-2.                                                  CL127
00211      05  FILLER                  PIC  X(12)  VALUE SPACES.           CL128
00212      05  WS-ENTITY-NAME          PIC  X(40).                         CL127
00213      05  FILLER                  PIC  X(20)  VALUE SPACES.           CL127
00214      05  WS-CONTACT-NAME         PIC  X(51).                         CL127
00215      05  FILLER                  PIC  X(09)  VALUE SPACES.           CL127
00216                                                                      CL127
00217  01  FOOTING-LINE-1               PIC X(133) VALUE SPACES.           CL*37
00218  01  FOOTING-LINE-2               PIC X(133) VALUE SPACES.        EFTBR120
00219                                                                   EFTBR120
00220  01  FOOTING-LINE-3.                                              EFTBR120
00221      05  FILLER                   PIC  X(24)  VALUE SPACES.          CL*68
00222      05  WS-FOOTING-CNT           PIC  ZZ,ZZ9.                    EFTBR120
00223      05  FILLER                   PIC  X(02)  VALUE SPACES.       EFTBR120
00224      05  FILLER                   PIC  X(27)  VALUE                  CL*68
00225                       'STATUS CHANGE RECORDS COUNT'.                 CL*68
00226                                                                      CL*56
00227  01  FOOTING-LINE-4               PIC X(133)  VALUE SPACES.          CL*56
00228                                                                      CL*56
00229  01  FOOTING-LINE-5.                                                 CL*56
00230      05  FILLER                   PIC  X(25) VALUE SPACES.           CL*56
00231      05  FILLER                   PIC  X(17) VALUE                EFTBR120
00232                       '*** END OF REPORT'.                        EFTBR120
00233      EJECT                                                        EFTBR120
00234                                                                      CL*56
00235  LINKAGE SECTION.                                                 EFTBR120
00236                                                                   EFTBR120
00237  01  LRCM-LINK-AREA.                                              EFTBR120
00238  ++INCLUDE DTSILRCM                                               EFTBR120
00239      EJECT                                                        EFTBR120
00240  01  R120-REC.                                                       CL*61
00241  ++INCLUDE EFTIR120                                                  CL*61
00242      EJECT                                                        EFTBR120
00243  PROCEDURE DIVISION USING LRCM-LINK-AREA                          EFTBR120
00244                           R120-REC.                                  CL*62
00245                                                                   EFTBR120
00246      IF FIRST-TIME-IND = 'Y'                                      EFTBR120
00247          PERFORM I1000-INITIATE THRU I1000-EXIT                   EFTBR120
00248          MOVE 'N' TO FIRST-TIME-IND.                              EFTBR120
00249                                                                   EFTBR120
00250      IF LRCM-EOR-88                                               EFTBR120
00251          PERFORM T1000-TERMINATE THRU T1000-EXIT                  EFTBR120
00252      ELSE                                                         EFTBR120
00253          PERFORM P1000-PROCESS-REPORT THRU P1000-EXIT.               CL*58
00254                                                                   EFTBR120
00255      GOBACK.                                                      EFTBR120
00256      EJECT                                                        EFTBR120
00257  I1000-INITIATE.                                                  EFTBR120
00258                                                                   EFTBR120
00259      OPEN OUTPUT PRT-FILE.                                           CL*51
00260      MOVE LRCM-SYS-DATE TO HDR1-LRCM-SYS-DATE.                       CL*43
00261      MOVE LRCM-SYS-TIME TO HDR2-LRCM-SYS-TIME.                    EFTBR120
00262      MOVE SPACES TO PRT-RECORD.                                      CL*51
00263                                                                   EFTBR120
00264  I1000-EXIT.                                                      EFTBR120
00265      EXIT.                                                        EFTBR120
00266      SKIP3                                                           CL*58
00267                                                                      CL*20
00268  P1000-PROCESS-REPORT.                                               CL*40
00269                                                                      CL*20
00270      MOVE R120-EMP-NO               TO WS-EMP-NO.                    CL*61
00271      MOVE R120-SALE-DATE            TO L001-FED-8-DATE-9.            CL*65
00272      SET L001-FROM-FED-8            TO TRUE.                         CL*65
00273      PERFORM S001-DATE              THRU S001-EXIT.                  CL*65
00274                                                                      CL103
00275      IF L001-INVALID-DATE                                            CL103
00276 *       MOVE R120-SALE-DATE         TO WS-SALE-DATE                  CL104
00277         MOVE SPACES                 TO WS-SALE-DATE                  CL104
00278      ELSE                                                            CL103
00279         IF L001-CAL-8-DATE-9 = ZEROS                                 CL103
00280            MOVE SPACES              TO WS-SALE-DATE                  CL103
00281         ELSE                                                         CL103
00282            MOVE L001-SLASH-8-DATE   TO WS-SALE-DATE.                 CL103
00283                                                                      CL*65
00284      MOVE R120-LAST-WAGES-PAID-DATE TO L001-FED-8-DATE-9.            CL*65
00285      SET L001-FROM-FED-8            TO TRUE.                         CL*65
00286      PERFORM S001-DATE              THRU S001-EXIT.                  CL*65
00287                                                                      CL103
00288      IF L001-INVALID-DATE                                            CL103
00289 *       MOVE R120-LAST-WAGES-PAID-DATE TO WS-LAST-WAGES-PAID-DATE    CL104
00290         MOVE SPACES                    TO WS-LAST-WAGES-PAID-DATE    CL104
00291      ELSE                                                            CL103
00292         IF L001-CAL-8-DATE-9 = ZEROS                                 CL103
00293            MOVE SPACES                 TO WS-LAST-WAGES-PAID-DATE    CL103
00294         ELSE                                                         CL103
00295            MOVE L001-SLASH-8-DATE      TO WS-LAST-WAGES-PAID-DATE.   CL103
00296                                                                      CL*65
00297      IF R120-FEIN > ZEROS                                            CL*95
00298         MOVE R120-FEIN              TO WS-FEIN                       CL*95
00299         MOVE WS-FEIN (1:2)          TO DTL1-FEIN2                    CL*95
00300         MOVE '-'                    TO WS-DASH                       CL*95
00301         MOVE WS-FEIN (3:7)          TO DTL1-FEIN7                    CL*95
00302      ELSE                                                            CL*95
00303         MOVE SPACES                 TO DTL1-FEIN2                    CL*95
00304         MOVE SPACE                  TO WS-DASH                       CL*95
00305         MOVE SPACES                 TO DTL1-FEIN7                    CL*95
00306      END-IF.                                                         CL*95
00307                                                                      CL*95
00308      MOVE R120-TRACE-NO             TO WS-TRACE-NO.                  CL*81
00309                                                                      CL*77
00310 *?   IF R120-NAME-YES-88                                             CL114
00311 *?      MOVE 'YES'                  TO WS-NAME                       CL114
00312 *?   ELSE                                                            CL114
00313 *?      MOVE 'NO '                  TO WS-NAME.                      CL114
00314                                                                      CL*77
00315      IF R120-ADDR-NO-CHANGE-88                                       CL*77
00316         MOVE 'NO '                  TO WS-ADDRESS                    CL*77
00317      ELSE                                                            CL*77
00318         MOVE 'YES'                  TO WS-ADDRESS.                   CL*77
00319                                                                      CL*77
00320      IF R120-CONTACT-PHONE = SPACES                                  CL113
00321         MOVE SPACE                 TO WRK-LEFT-PARN                  CL118
00322         MOVE SPACE                 TO WRK-AREA-CODE                  CL118
00323         MOVE SPACE                 TO WRK-RIGHT-PARN                 CL118
00324         MOVE SPACE                 TO WRK-EXCHANGE                   CL118
00325         MOVE SPACE                 TO WRK-DASH                       CL118
00326         MOVE SPACE                 TO WRK-NUMBER                     CL118
00327         MOVE SPACE                 TO WRK-EXT                        CL126
00328         MOVE WRK-EDIT-PHONE        TO WS-PHONE                       CL115
00329      ELSE                                                            CL113
00330         MOVE '('                   TO WRK-LEFT-PARN                  CL115
00331         MOVE R120-VOICE-AREA-CD    TO WRK-AREA-CODE                  CL115
00332         MOVE ')'                   TO WRK-RIGHT-PARN                 CL117
00333         MOVE R120-VOICE-PREFIX     TO WRK-EXCHANGE                   CL113
00334         MOVE '-'                   TO WRK-DASH                       CL115
00335         MOVE R120-VOICE-SUFFIX     TO WRK-NUMBER                     CL113
00336         MOVE R120-VOICE-EXT        TO WRK-EXT                        CL126
00337         MOVE WRK-EDIT-PHONE        TO WS-PHONE.                      CL113
00338                                                                      CL113
00339      MOVE R120-STATUS-CHNG-DESC     TO WS-STATUS-CHNG-DESC.          CL*74
00340                                                                      CL*39
00341      PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.                     CL*20
00342      WRITE PRT-RECORD  FROM DETAIL-LINE-1  AFTER 1.                  CL127
00343      ADD  1    TO WS-LINE-CNT2.                                      CL127
00344                                                                      CL127
00345      IF R120-ENTITY-NAME = SPACE AND R120-CONTACT-NAME = SPACES      CL127
00346         NEXT SENTENCE                                                CL127
00347      ELSE                                                            CL127
00348         IF R120-ENTITY-NAME NOT = SPACE                              CL131
00349            MOVE R120-ENTITY-NAME TO WS-ENTITY-NAME                   CL131
00350         ELSE                                                         CL131
00351            MOVE SPACES           TO WS-ENTITY-NAME                   CL131
00352         END-IF                                                       CL131
00353         IF R120-CONTACT-NAME NOT = SPACES                            CL131
00354            MOVE R120-CONTACT-NAME TO WS-CONTACT-NAME                 CL131
00355         ELSE                                                         CL131
00356            MOVE SPACES            TO WS-CONTACT-NAME                 CL131
00357         END-IF                                                       CL131
00358         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                   CL127
00359         WRITE PRT-RECORD  FROM DETAIL-LINE-2  AFTER 1                CL127
00360         ADD  1    TO WS-LINE-CNT2.                                   CL127
00361                                                                      CL127
00362      WRITE PRT-RECORD  FROM SPACES-LINE AFTER 1.                     CL127
00363      ADD  1    TO WS-LINE-CNT2.                                      CL127
00364                                                                      CL127
00365      ADD +1    TO WS-FOOT-CNT.                                       CL*58
00366                                                                      CL*20
00367  P1000-EXIT.                                                         CL*20
00368      EXIT.                                                           CL*20
00369                                                                      CL*20
00370  P2000-PRINT-HEADER.                                              EFTBR120
00371      IF WS-LINE-CNT GREATER 55 OR                                    CL*58
00372           WS-LINE-CNT2 GREATER 55                                    CL*58
00373         MOVE +0          TO WS-LINE-CNT                           EFTBR120
00374         MOVE +0          TO WS-LINE-CNT2                          EFTBR120
00375         ADD  +1          TO WS-PAGE-CNT                           EFTBR120
00376         MOVE WS-PAGE-CNT TO HDR3-PAGE                             EFTBR120
00377         WRITE PRT-RECORD  FROM HEADER-1 AFTER TOP-OF-PAGE            CL*53
00378         WRITE PRT-RECORD  FROM HEADER-2 AFTER 1                      CL*53
00379         WRITE PRT-RECORD  FROM HEADER-3 AFTER 1                      CL*53
00380         WRITE PRT-RECORD  FROM HEADER-4 AFTER 1                      CL*53
00381         WRITE PRT-RECORD  FROM HEADER-5 AFTER 1                      CL*53
00382         WRITE PRT-RECORD  FROM HEADER-6 AFTER 1                      CL*53
00383         WRITE PRT-RECORD  FROM SPACES-LINE AFTER 1                   CL127
00384         ADD +7    TO WS-LINE-CNT2.                                   CL*58
00385  P2000-EXIT.                                                      EFTBR120
00386      EXIT.                                                        EFTBR120
00387                                                                      CL*20
00388  T1000-TERMINATE.                                                 EFTBR120
00389                                                                   EFTBR120
00390      IF WS-LINE-CNT2 > 52 OR WS-FOOT-CNT = ZERO                      CL*58
00391         PERFORM P2000-PRINT-HEADER THRU P2000-EXIT                EFTBR120
00392      END-IF.                                                      EFTBR120
00393      MOVE WS-FOOT-CNT  TO WS-FOOTING-CNT.                            CL*58
00394      WRITE PRT-RECORD  FROM FOOTING-LINE-1 AFTER 1.                  CL*54
00395      WRITE PRT-RECORD  FROM FOOTING-LINE-2 AFTER 1.                  CL*54
00396      WRITE PRT-RECORD  FROM FOOTING-LINE-3 AFTER 1.                  CL*54
00397      WRITE PRT-RECORD  FROM FOOTING-LINE-4 AFTER 1.                  CL*54
00398      WRITE PRT-RECORD  FROM FOOTING-LINE-5 AFTER 1.                  CL*54
00399                                                                      CL*20
00400      CLOSE PRT-FILE.                                                 CL*51
00401                                                                   EFTBR120
00402  T1000-EXIT.                                                      EFTBR120
00403      EXIT.                                                        EFTBR120
00404      EJECT                                                        EFTBR120
00405                                                                      CL*23
00406  S001-DATE.                                                          CL*63
00407      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL*63
00408  S001-EXIT.                                                          CL*63
00409      EXIT.                                                           CL*63
00410                                                                   EFTBR120
00411  S999-ABEND.                                                      EFTBR120
00412                                                                   EFTBR120
00413      DISPLAY '*** EFTBR120 ABENDING.  '                              CL*61
00414              WRK-ABEND-MSG.                                          CL*24
00415                                                                      CL*24
00416      CALL 'DTSBU999' USING WRK-ABEND-CD.                          EFTBR120
00417                                                                   EFTBR120
00418  S999-EXIT.                                                       EFTBR120
00419      EXIT.                                                        EFTBR120
