00001  IDENTIFICATION DIVISION.                                         03/18/04
00002  PROGRAM-ID.             EFTBD120.                                EFTBD120
00003  AUTHOR.                 NORTHROP GRUMMAN.                           LV147
00004  DATE-WRITTEN.           JULY 2003.                                  CL168
00005  DATE-COMPILED.                                                      CL146
00006      SKIP3                                                           CL146
00007 *****                                                                CL146
00008 *                                                                    CL146
00009 *  FUNCTION: 1. THIS PROGRAM PROCESSES STATUS UPDATE RECORDS         CL198
00010 *               FROM THE WEB REPORTING SYSTEM. THE EFTIFEST          CL232
00011 *               RECORD WHICH CONTAINS THE STATUS OF EACH FIELD       CL232
00012 *               TO BE CHANGED.                                       CL*50
00013 *            2. IT MATCHES THE EMP-NO WITH THE MTAD MASTER TO        CL198
00014 *               PRODUCE A BUSINESS T002 STATUS CHANGE REC. ON        CL199
00015 *               THE FIELDS OF BUSINESS NAME, ADDRESS, TELEPHONE      CL232
00016 *               NUMBER, OR EMAIL ADDRESS.                            CL232
00017 *            3. THEN IT MATCHES THE EMP-NO WITH THE MOPO MASTER      CL199
00018 *               TO PRODUCE A CONTACT T002 STATUS CHANGE REC. ON      CL199
00019 *               THE FIELDS OF CONTACT NAME, SSN, TITLE, TELEPHONE    CL232
00020 *               NUMBER, OR FAX NUMBER.                               CL232
00021 *            4. IT ALSO PRODUCES PRINTED REPORTS FOR OTHER           CL198
00022 *               STATUS CHANGES.                                      CL180
00023 *                                                                    CL146
00024 *    MODIFICATION LOG:                                               CL146
00025 *                                                                    CL146
00026 *    07/15/03  INITIAL DEVELOPMENT                                   CL228
00027 *              WORK ORDER:                      PROGRAMMER: RW1      CL**3
00028 *                                                                    CL**3
00029 *    99/99/99  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**3
00030 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**3
00031 *              WORK ORDER:                      PROGRAMMER: XXX      CL**3
00032 *                                                                    CL146
00033 *  DESCRIPTION:                                                      CL146
00034 *                                                                    CL146
00035 *    INITIATION:                                                     CL146
00036 *      NONE                                                          CL*91
00037 *                                                                    CL146
00038 *    PARAMETERS INPUT:                                               CL*50
00039 *      NONE                                                          CL*91
00040 *                                                                    CL*50
00041 *    PROCESSING:                                                     CL146
00042 *      READ THE STATUS UPDATE FILE SEQUENTIALLY FROM GOVONE          CL169
00043 *      AND MATCHES THE FEST-EMP-NO WITH THE MPRF MASTER FILE,        CL170
00044 *      MTAD, AND MOPO FILES TO CREATE A T002 STATUS UPDATE           CL*55
00045 *      FILE FOR ACCOUNT UPDATING PROCESSES.                          CL*50
00046 *                                                                    CL181
00047 *    TERMINATION:                                                    CL146
00048 *      OUTPUT STATISTICAL RECORDS COUNT.                             CL*50
00049 *                                                                    CL146
00050 *    RECORDS READ:                                                   CL206
00051 *      MASTER:                                                       CL**3
00052 *        MPRF, MTAD, AND MOPO MASTER FILES.                          CL*55
00053 *                                                                    CL**3
00054 *      ALTERNATE INDEX:                                              CL146
00055 *        YES.                                                        CL170
00056 *                                                                    CL146
00057 *      REFERENCE:                                                    CL146
00058 *        NONE.                                                       CL146
00059 *                                                                    CL146
00060 *    REPORT RECORDS WRITTEN:                                         CL146
00061 *        STATUS REPORT.                                              CL170
00062 *                                                                    CL*50
00063 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                   CL241
00064 *        T002                                                        CL170
00065 *                                                                    CL146
00066 *    MODULES CALLED:                                                 CL146
00067 *        DTSBU001  DATE CONVERSION/EDIT.                             CL146
00068 *        DTSBU004  QUARERLY SUMMARY REPORT REC.                      CL*47
00069 *        DTSBU910  VSAM MASTER FILES I/O.                            CL*74
00070 *        DTSBU927  VARIABLE LENGTH RECORD BTC OUTPUT.                CL166
00071 *        DTSBU941  VARIABLE LENGTH RECORD INPUT 1.                   CL166
00072 *        DTSBU946  VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.       CL*35
00073 *        DTSBU947  VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 2.       CL*35
00074 *                                                                    CL146
00075 *    VERMONT REFERENCE:                                              CL146
00076 *        NONE.                                                       CL146
00077 *                                                                    CL146
00078 *****                                                                CL146
00079      SKIP3                                                           CL*13
00080  ENVIRONMENT DIVISION.                                               CL146
00081                                                                      CL211
00082  INPUT-OUTPUT SECTION.                                               CL*58
00083                                                                      CL*58
00084  DATA DIVISION.                                                      CL*13
00085                                                                      CL*58
00086  WORKING-STORAGE SECTION.                                            CL146
000865 77  PAN-VALET PICTURE X(24) VALUE '147EFTBD120  03/18/04'.          CL146
00087                                                                      CL*40
00088  01  WRK-AREA.                                                       CL146
00089      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +120.   CL243
00090      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'EFTBD120'.   CL243
00091      05  WRK-ABEND-MSG               PIC  X(60).                     CL*83
00092      05  WRK-TRACE-IND               PIC  X(01)  VALUE SPACES.       CL126
00093                                                                      CL*98
00094      05  DISP-DATE                   PIC  X(10)  VALUE SPACES.       CL*92
00095      05  DISP-TIME                   PIC  X(08)  VALUE SPACES.       CL*92
00096      05  DISP-ABSTIME                PIC  X(16)  VALUE SPACES.       CL132
00097      05  WRK-L076-NAME               PIC  X(32)  VALUE SPACES.       CL125
00098                                                                      CL132
00099      05  WRK-CURR-TIME               PIC  S9(07) COMP-3 VALUE +0.    CL133
00100      05  WRK-CURR-DATE               PIC  S9(09) COMP-3 VALUE +0.    CL132
00101      05  WRK-CURR-YR                 PIC  9(04)  VALUE ZEROS.        CL*92
00102      05  WRK-ABSTIME                 PIC  S9(15) COMP-3 VALUE +0.    CL132
00103      05  WRK-MPRF-FEIN               PIC  S9(09) COMP-3 VALUE +0.    CL102
00104                                                                      CL132
00105      05  WRK-MPRF-READ-CNT           PIC S9(07)  COMP-3 VALUE +0.    CL101
00106      05  WRK-ERROR-WRITE-CNT         PIC S9(07)  COMP-3 VALUE +0.    CL*78
00107      05  WRK-STATUS-READ-CNT         PIC S9(07)  COMP-3 VALUE +0.    CL234
00108      05  WRK-BTC-WRITE-CNT           PIC S9(07)  COMP-3 VALUE +0.    CL172
00109      05  WRK-R907-REC-CNT            PIC S9(07)  COMP-3 VALUE +0.    CL172
00110      05  WRK-R120-WRITE-CNT          PIC S9(07)  COMP-3 VALUE +0.    CL*23
00111      05  WRK-T002-ADDR-CNT           PIC S9(07)  COMP-3 VALUE +0.    CL240
00112      05  WRK-T002-CONTACT-CNT        PIC S9(07)  COMP-3 VALUE +0.    CL240
00113      05  WRK-REPORT-WRITE-CNT        PIC S9(07)  COMP-3 VALUE +0.    CL209
00114                                                                      CL112
00115      05  WRK-MPRF-IND                PIC  X(01).                     CL182
00116          88 WRK-MPRF-OK-88              VALUE '0'.                   CL182
00117          88 WRK-MPRF-NO-REC-88          VALUE '1'.                   CL235
00118                                                                      CL182
00119      05  WRK-ERROR-IND               PIC  X(01).                     CL*37
00120          88 WRK-ERROR-YES-88            VALUE 'Y'.                   CL182
00121          88 WRK-ERROR-NO-88             VALUE 'N'.                   CL182
00122                                                                      CL141
00123      05  WRK-MOPO-IND                PIC  X(01).                     CL141
00124          88 WRK-MOPO-FOUND-YES-88       VALUE 'Y'.                   CL182
00125          88 WRK-MOPO-FOUND-NO-88        VALUE 'N'.                   CL182
00126                                                                      CL176
00127      05  WRK-STATUS-CHNG-IND         PIC  X(01).                     CL240
00128          88 WRK-STATUS-CHNG-YES-88      VALUE 'Y'.                   CL240
00129          88 WRK-STATUS-CHNG-NO-88       VALUE 'N'.                   CL240
00130                                                                      CL241
00131      05  WRK-MTAD-T002-IND           PIC  X(01).                     CL*18
00132          88 WRK-MTAD-T002-YES-88        VALUE 'Y'.                   CL*18
00133          88 WRK-MTAD-T002-NO-88         VALUE 'N'.                   CL*18
00134                                                                      CL238
00135      05  WRK-MOPO-T002-IND           PIC  X(01).                     CL*18
00136          88 WRK-MOPO-T002-YES-88        VALUE 'Y'.                   CL*18
00137          88 WRK-MOPO-T002-NO-88         VALUE 'N'.                   CL*18
00138                                                                      CL*18
00139      05  WRK-CONT-T002-IND           PIC  X(01).                     CL118
00140          88 WRK-CONT-T002-YES-88        VALUE 'Y'.                   CL118
00141          88 WRK-CONT-T002-NO-88         VALUE 'N'.                   CL118
00142                                                                      CL118
00143      05  WRK-NAME-IN                 PIC  X(40).                     CL238
00144      05  WRK-NAME-OUT                PIC  X(40).                     CL238
00145      05  START-SUB                   PIC S9(04) COMP.                CL238
00146      05  SUB1                        PIC S9(04) COMP.                CL238
00147      05  SUB2                        PIC S9(04) COMP.                CL238
00148                                                                      CL*91
00149  01  ERROR-ADDRESS-AREA.                                             CL*91
00150      05  FILLER                      PIC X(03).                      CL*95
00151      05  WRK-ERROR-ADDR              PIC X(26).                      CL100
00152      05  WRK-ERROR-CITY              PIC X(16).                      CL100
00153      05  WRK-ERROR-STATE             PIC X(02).                      CL*91
00154      05  FILLER                      PIC X(01).                      CL*96
00155      05  WRK-ERROR-ZIP               PIC X(10).                      CL*91
00156                                                                      CL*91
00157  01  ERROR-MESSAGE-AREA.                                             CL236
00158      05  MSG1-CHG-ONLY.                                              CL236
00159          10  MSG1-ID         PIC  X(03)  VALUE '001'.                CL236
00160          10  MSG1-TEXT.                                              CL236
00161              15  FILLER      PIC  X(30)                              CL236
00162                    VALUE 'TRANSACTION FAILED - CHARGING '.           CL236
00163              15  FILLER      PIC  X(30)                              CL236
00164                    VALUE 'ONLY EMPLOYER                 '.           CL236
00165                                                                      CL236
00166      05  MSG2-INACTIVE.                                              CL236
00167          10  MSG2-ID         PIC  X(03)  VALUE '002'.                CL236
00168          10  MSG2-TEXT.                                              CL236
00169              15  FILLER      PIC  X(30)                              CL236
00170                    VALUE 'STATUS CHANGE ACCEPTED FOR INA'.           CL236
00171              15  FILLER      PIC  X(30)                              CL236
00172                    VALUE 'CTIVE EMPLOYER                '.           CL236
00173                                                                      CL236
00174      05  MSG3-NOT-LIABLE.                                            CL236
00175          10  MSG3-ID         PIC  X(03)  VALUE '003'.                CL236
00176          10  MSG3-TEXT.                                              CL236
00177              15  FILLER      PIC  X(30)                              CL236
00178                    VALUE 'STATUS CHANGE ACCEPTED FOR NON'.           CL236
00179              15  FILLER      PIC  X(30)                              CL236
00180                    VALUE '-LIABLE EMPLOYER              '.           CL236
00181                                                                      CL236
00182      05  MSG4-INVALID-ADDRESS.                                       CL237
00183          10  MSG4-ID         PIC  X(03)  VALUE '004'.                CL237
00184          10  MSG4-TEXT.                                              CL237
00185              15  FILLER      PIC  X(30)                              CL237
00186                    VALUE 'TRANSACTION REJECTED - INVALID'.           CL237
00187              15  FILLER      PIC  X(30)                              CL237
00188                    VALUE ' ADDRESS                      '.           CL237
00189                                                                      CL237
00190      05  MSG5-INCOMPLETE-NAMES.                                      CL*71
00191          10  MSG5-ID         PIC  X(03)  VALUE '005'.                CL238
00192          10  MSG5-TEXT.                                              CL238
00193              15  FILLER      PIC  X(30)                              CL238
00194                    VALUE 'TRANSACTION REJECTED - NO TRAD'.           CL*73
00195              15  FILLER      PIC  X(30)                              CL238
00196                    VALUE 'E/ENTITY NAMES                '.           CL*73
00197                                                                      CL238
00198      05  MSG6-INCOMPLETE-CONTACT.                                    CL*71
00199          10  MSG6-ID         PIC  X(03)  VALUE '006'.                CL*71
00200          10  MSG6-TEXT.                                              CL*71
00201              15  FILLER      PIC  X(30)                              CL*71
00202                    VALUE 'TRANSACTION REJECTED - CONTACT'.           CL*71
00203              15  FILLER      PIC  X(30)                              CL*71
00204                    VALUE ' INFORMATION NOT COMPLETE     '.           CL*71
00205                                                                      CL*71
00206      EJECT                                                           CL211
00207  01  FEST-REC.                                                       CL176
00208  ++INCLUDE EFTIFEST                                                  CL167
00209      SKIP3                                                           CL*58
00210  01  T002-REC.                                                       CL167
00211  ++INCLUDE DTSIT002                                                  CL167
00212      SKIP3                                                           CL167
00213  01  R120-REC.                                                       CL*22
00214  ++INCLUDE EFTIR120                                                  CL*22
00215      SKIP3                                                           CL*22
00216  01  EFTE-REC.                                                       CL*22
00217  ++INCLUDE EFTERMSG                                                  CL*22
00218      SKIP3                                                           CL*22
00219  01  L001-LINK-AREA.                                                 CL146
00220  ++INCLUDE DTSIL001                                                  CL146
00221      EJECT                                                           CL146
00222  01  L004-LINK-AREA.                                                 CL*24
00223  ++INCLUDE DTSIL004                                                  CL*24
00224      EJECT                                                           CL*24
00225  01  L005-COMM-AREA.                                                 CL*61
00226  ++INCLUDE DTSIL005                                                  CL*61
00227      EJECT                                                           CL100
00228  01  L021-COMM-AREA.                                                 CL*17
00229  ++INCLUDE DTSIL021                                                  CL*17
00230      EJECT                                                           CL*17
00231  01  L072-LINK-AREA.                                                 CL242
00232  ++INCLUDE DTSIL072                                                  CL241
00233      EJECT                                                           CL241
00234  01  L076-LINK-AREA.                                                 CL125
00235  ++INCLUDE DTSIL076                                                  CL125
00236      EJECT                                                           CL*15
00237  01  L910-LINK-AREA.                                                 CL*94
00238  ++INCLUDE DTSIL910                                                  CL*94
00239      EJECT                                                           CL162
00240  01  MSKL-REC.                                                       CL234
00241  ++INCLUDE DTSIMSKL                                                  CL234
00242      EJECT                                                           CL234
00243  01  MPRF-REC.                                                       CL234
00244  ++INCLUDE DTSIMPRF                                                  CL234
00245      EJECT                                                           CL234
00246  01  MTAD-REC.                                                       CL234
00247  ++INCLUDE DTSIMTAD                                                  CL234
00248      EJECT                                                           CL234
00249  01  MOPO-REC.                                                       CL234
00250  ++INCLUDE DTSIMOPO                                                  CL234
00251      EJECT                                                           CL234
00252  01  L927-LINK-AREA.                                                 CL173
00253  ++INCLUDE DTSIL927                                                  CL167
00254      EJECT                                                           CL167
00255  01  TSKL-REC.                                                       CL167
00256  ++INCLUDE DTSITSKL                                                  CL167
00257      EJECT                                                           CL167
00258  01  L941-LINK-AREA.                                                 CL162
00259  ++INCLUDE DTSIL941                                                  CL162
00260      EJECT                                                           CL*94
00261  01  STATUS-REC.                                                     CL234
00262  ++INCLUDE DTSIRSK3                                                  CL234
00263     SKIP3                                                            CL234
00264  01  F907-REC.                                                       CL**8
00265  ++INCLUDE EFTIF907                                                  CL**6
00266      EJECT                                                           CL226
00267                                                                      CL249
00268  LINKAGE SECTION.                                                    CL249
00269  01  EFT-REC-TYPE-LINK-AREA.                                         CL249
00270  ++INCLUDE EFTIL100                                                  CL249
00271                                                                      CL249
00272  01  RSKL-REC.                                                       CL249
00273  ++INCLUDE EFTIRSKL                                                  CL249
00274                                                                      CL249
00275  PROCEDURE DIVISION USING                                            CL248
00276                     EFT-REC-TYPE-LINK-AREA                           CL248
00277                     RSKL-REC.                                        CL248
00278                                                                      CL248
00279       MOVE RSKL-REC TO FEST-REC.                                     CL248
00280                                                                      CL248
00281       IF EFT-L100-CMD-INIT-88                                        CL248
00282          PERFORM I0000-INITIALIZE THRU I0000-EXIT                    CL248
00283       ELSE                                                           CL248
00284         IF EFT-L100-CMD-PROCESS-88                                   CL248
00285            PERFORM P0000-PROCESS THRU P0000-EXIT                     CL248
00286         ELSE                                                         CL248
00287           IF EFT-L100-CMD-TERMINATE-88                               CL251
00288              PERFORM T0000-TERMINATE THRU T0000-EXIT                 CL248
00289           ELSE                                                       CL248
00290              DISPLAY 'INVLAID CALL FROM BD100 '                      CL248
00291              PERFORM S999-ABEND THRU S999-EXIT.                      CL248
00292                                                                      CL*62
00293      GOBACK.                                                         CL146
00294      EJECT                                                           CL146
00295  I0000-INITIALIZE.                                                   CL146
00296                                                                      CL*72
00297      SET WRK-MPRF-OK-88        TO TRUE.                              CL151
00298                                                                      CL*72
00299      PERFORM I1000-SYS-DATE    THRU I1000-EXIT.                      CL*74
00300      PERFORM I2000-OPEN-FILES  THRU I2000-EXIT.                      CL*74
00301                                                                      CL*63
00302      PERFORM I3000-INIT-T002   THRU I3000-EXIT.                      CL240
00303                                                                      CL240
00304  I0000-EXIT.                                                         CL146
00305      EXIT.                                                           CL146
00306                                                                      CL107
00307  I1000-SYS-DATE.                                                     CL*72
00308      SET L005-FROM-SYS      TO TRUE.                                 CL*72
00309      PERFORM S005-SYS-DATE  THRU S005-EXIT.                          CL*72
00310      MOVE L005-DATE         TO DISP-DATE WRK-CURR-DATE.              CL132
00311      MOVE L005-TIME         TO DISP-TIME WRK-CURR-TIME.              CL132
00312      MOVE L005-ABSTIME      TO DISP-ABSTIME WRK-ABSTIME.             CL132
00313                                                                      CL132
00314 *    DISPLAY '    '.                                                 CL245
00315 *    DISPLAY 'L005-DATE ' DISP-DATE  ' L005-TIME ' DISP-TIME         CL245
00316 *            ' L005-ABSTIME ' DISP-ABSTIME.                          CL247
00317  I1000-EXIT.                                                         CL*72
00318      EXIT.                                                           CL*72
00319                                                                      CL**1
00320  I2000-OPEN-FILES.                                                   CL*72
00321                                                                      CL172
00322      MOVE LENGTH OF T002-REC TO T002-LENGTH.                         CL172
00323      MOVE LENGTH OF F907-REC TO F907-LENGTH.                         CL**6
00324      MOVE LENGTH OF R120-REC TO R120-LENGTH.                         CL*25
00325                                                                      CL161
00326  I2000-EXIT.                                                         CL*72
00327      EXIT.                                                           CL*58
00328                                                                      CL*58
00329  I3000-INIT-T002.                                                    CL240
00330                                                                      CL240
00331      MOVE ZERO          TO T002-EMP-NO                               CL240
00332                            T002-SYS-DATE                             CL240
00333                            T002-SYS-TIME.                            CL240
00334                                                                      CL240
00335      MOVE SPACES        TO T002-ORIGIN                               CL240
00336                            T002-DATA-AREA.                           CL240
00337                                                                      CL240
00338  I3000-EXIT.                                                         CL240
00339      EXIT.                                                           CL240
00340                                                                      CL240
00341 **************************************************************       CL146
00342 *  READ THE EFT STATUS CHANGE FILE FROM GOVONE AND           *       CL175
00343 *  MATCHES THE EMPLOYER NNUMBER WITH THE MPRF MASTER.        *       CL175
00344 **************************************************************       CL146
00345                                                                      CL146
00346  P0000-PROCESS.                                                      CL146
00347         DISPLAY ' FEST EMP NO...... ' FEST-EMP-NO                    CL127
00348      SET WRK-MOPO-FOUND-NO-88   TO TRUE.                             CL*90
00349      SET WRK-MTAD-T002-YES-88   TO TRUE.                             CL138
00350      SET WRK-MOPO-T002-YES-88   TO TRUE.                             CL*90
00351      SET WRK-CONT-T002-YES-88   TO TRUE.                             CL120
00352      SET WRK-STATUS-CHNG-NO-88  TO TRUE.                             CL*90
00353      ADD +1                     TO WRK-STATUS-READ-CNT               CL*90
00354      PERFORM I3000-INIT-T002    THRU I3000-EXIT                      CL*90
00355                                                                      CL*18
00356      PERFORM P1100-READ-MPRF     THRU P1100-EXIT                     CL*90
00357                                                                      CL*18
00358      IF WRK-MPRF-NO-REC-88                                           CL*90
00359         DISPLAY ' EMP REC NOT FOUND ' FEST-EMP-NO                    CL117
00360         GO TO P0000-EXIT.                                            CL*90
00361                                                                      CL*18
00362      PERFORM P1200-CHECK-FEST-NAME     THRU P1200-EXIT.              CL122
00363                                                                      CL120
00364      IF WRK-MTAD-T002-YES-88                                         CL*90
00365         PERFORM P1300-CHECK-FEST-ADDRESS  THRU P1300-EXIT            CL135
00366         PERFORM P1600-CHECK-FEST-DATA THRU P1600-EXIT                CL120
00367         PERFORM P1700-WRITE-MTAD-T002 THRU P1700-EXIT                CL134
00368      ELSE                                                            CL120
00369         DISPLAY '***** NO MTAD T002 REC CREATED ' FEST-EMP-NO.       CL134
00370 *                                                                    CL120
00371 ***** WRITE T002 CONTACT REC.                                        CL118
00372 *                                                                    CL118
00373      PERFORM I3000-INIT-T002      THRU I3000-EXIT                    CL*90
00374      INITIALIZE                   MOPO-REC                           CL*90
00375      PERFORM P2000-MOPO           THRU P2000-EXIT                    CL*90
00376 *                                                                    CL128
00377      PERFORM P2100-CONT-NAME      THRU P2100-EXIT                    CL128
00378 *                                                                    CL118
00379      IF WRK-CONT-T002-YES-88                                         CL118
00380         DISPLAY ' T002 YES    FOUND ' FEST-EMP-NO                    CL127
00381         PERFORM P2300-WRITE-CONT-T002 THRU P2300-EXIT.               CL118
00382 *                                                                    CL120
00383 ***** WRITE 120 REPORT REC.                                          CL118
00384 *                                                                    CL118
00385      PERFORM P3000-STATUS-SALES   THRU P3000-EXIT                    CL*90
00386      PERFORM P3100-STATUS-PAID    THRU P3100-EXIT                    CL*90
00387      PERFORM P3200-STATUS-DESC    THRU P3200-EXIT                    CL*90
00388      PERFORM P3300-STATUS-FEIN    THRU P3300-EXIT                    CL*90
00389      PERFORM P3400-STATUS-TRACE   THRU P3400-EXIT                    CL*90
00390                                                                      CL*18
00391      IF WRK-STATUS-CHNG-YES-88                                       CL*21
00392           PERFORM P3500-WRITE-R120 THRU P3500-EXIT.                  CL*36
00393                                                                      CL*18
00394  P0000-EXIT.                                                         CL146
00395      EXIT.                                                           CL146
00396                                                                      CL135
00397                                                                      CL234
00398  P1100-READ-MPRF.                                                    CL235
00399      MOVE LOW-VALUES           TO MSKL-KEY-AREA.                     CL235
00400      MOVE FEST-EMP-NO          TO MSKL-EMP-NO.                       CL235
00401      SET MSKL-PRF-88           TO TRUE.                              CL235
00402      PERFORM S910-READ         THRU S910-EXIT.                       CL235
00403      IF L910-NO-REC-88                                               CL235
00404         SET WRK-MPRF-NO-REC-88 TO TRUE                               CL240
00405         DISPLAY 'NO MPRF RECORD FOUND ' FEST-EMP-NO                  CL235
00406         GO TO P1100-EXIT                                             CL236
00407      ELSE                                                            CL235
00408         MOVE MSKL-REC          TO MPRF-REC                           CL235
00409         SET WRK-MPRF-OK-88     TO TRUE                               CL235
00410      END-IF.                                                         CL235
00411                                                                      CL235
00412      EVALUATE TRUE                                                   CL236
00413         WHEN MPRF-CLASS-CHG-ONLY-88                                  CL236
00414            MOVE MSG1-ID            TO F907-MSG-ID                    CL**6
00415            MOVE MSG1-TEXT          TO F907-MSG-TEXT                  CL*11
00416            PERFORM S946-ERROR      THRU S946-EXIT                    CL**6
00417                                                                      CL236
00418         WHEN MPRF-STATUS-INACT-88                                    CL236
00419            MOVE MSG2-ID            TO F907-MSG-ID                    CL**6
00420            MOVE MSG2-TEXT          TO F907-MSG-TEXT                  CL*11
00421            PERFORM S946-ERROR      THRU S946-EXIT                    CL**6
00422                                                                      CL236
00423         WHEN MPRF-STATUS-UNK-88                                      CL236
00424         OR   MPRF-STATUS-NEVERSUB-88                                 CL236
00425            MOVE MSG3-ID            TO F907-MSG-ID                    CL**6
00426            MOVE MSG3-TEXT          TO F907-MSG-TEXT                  CL*11
00427            PERFORM S946-ERROR      THRU S946-EXIT                    CL**6
00428                                                                      CL236
00429      END-EVALUATE.                                                   CL236
00430                                                                      CL236
00431  P1100-EXIT.                                                         CL235
00432      EXIT.                                                           CL235
00433                                                                      CL235
00434  P1200-CHECK-FEST-NAME.                                              CL122
00435 *BW1                                                                 CL*71
00436       MOVE SPACES              TO T002-BSNS-ENTITY-NAME.             CL122
00437       MOVE SPACES              TO T002-BSNS-TRADE-NAME.              CL122
00438                                                                      CL135
00439      IF (FEST-TRADE-NAME = SPACES OR LOW-VALUES) AND                 CL*71
00440           (FEST-ENTITY-NAME = SPACES OR LOW-VALUES)                  CL*71
00441         MOVE MSG5-ID            TO F907-MSG-ID                       CL*71
00442         MOVE MSG5-TEXT          TO F907-MSG-TEXT                     CL*71
00443         PERFORM S946-ERROR      THRU S946-EXIT                       CL*71
00444         SET WRK-MTAD-T002-NO-88 TO TRUE                              CL135
00445         GO TO P1200-EXIT.                                            CL*71
00446 *BW2                                                                 CL*71
00447                                                                      CL*71
00448      IF FEST-TRADE-NAME = SPACES OR LOW-VALUES                       CL244
00449         MOVE SPACES              TO T002-BSNS-TRADE-NAME             CL*55
00450      ELSE                                                            CL244
00451         MOVE FEST-TRADE-NAME         TO WRK-NAME-IN                  CL236
00452         MOVE SPACES                  TO WRK-NAME-OUT                 CL236
00453         PERFORM P1210-UPDATE-NAME    THRU P1210-EXIT                 CL241
00454         MOVE WRK-NAME-OUT        TO T002-BSNS-TRADE-NAME             CL120
00455      END-IF.                                                         CL236
00456                                                                      CL236
00457  P1200-EXIT.                                                         CL235
00458      EXIT.                                                           CL235
00459                                                                      CL235
00460  P1210-UPDATE-NAME.                                                  CL236
00461      MOVE +0                     TO START-SUB                        CL236
00462                                     SUB2.                            CL236
00463                                                                      CL236
00464      IF WRK-NAME-IN (1:2) = 'A '                                     CL236
00465         IF WRK-NAME-IN (4:1) = ' '                                   CL236
00466            NEXT SENTENCE                                             CL236
00467         ELSE                                                         CL236
00468            MOVE +3      TO START-SUB                                 CL236
00469         END-IF                                                       CL236
00470      ELSE                                                            CL236
00471         IF WRK-NAME-IN (1:3) = 'AN '                                 CL236
00472            MOVE +4      TO START-SUB                                 CL236
00473         ELSE                                                         CL236
00474            IF WRK-NAME-IN (1:4) = 'THE '                             CL236
00475               MOVE +5   TO START-SUB                                 CL236
00476            END-IF                                                    CL236
00477         END-IF                                                       CL236
00478      END-IF.                                                         CL236
00479                                                                      CL236
00480      IF START-SUB > +0                                               CL236
00481         PERFORM                                                      CL236
00482           VARYING SUB1 FROM START-SUB BY +1                          CL236
00483           UNTIL SUB1 > +40                                           CL236
00484             ADD +1          TO SUB2                                  CL236
00485             MOVE WRK-NAME-IN (SUB1:1) TO WRK-NAME-OUT (SUB2:1)       CL236
00486         END-PERFORM                                                  CL236
00487      ELSE                                                            CL236
00488         MOVE WRK-NAME-IN    TO WRK-NAME-OUT                          CL236
00489      END-IF.                                                         CL236
00490                                                                      CL236
00491  P1210-EXIT.                                                         CL236
00492      EXIT.                                                           CL236
00493                                                                      CL236
00494  P1300-CHECK-FEST-ADDRESS.                                           CL120
00495                                                                      CL120
00496         SET WRK-MTAD-T002-YES-88    TO TRUE                          CL120
00497         MOVE SPACES                 TO T002-BSNS-ATTN                CL120
00498         MOVE SPACES                 TO T002-BSNS-DELV1               CL120
00499         MOVE SPACES                 TO T002-BSNS-DELV2               CL120
00500         MOVE SPACES                 TO T002-BSNS-CITY                CL120
00501         MOVE SPACES                 TO T002-BSNS-ST                  CL120
00502         MOVE SPACES                 TO T002-BSNS-ZIP                 CL120
00503         MOVE SPACES        TO T002-BSNS-ENTITY-NAME                  CL142
00504                                                                      CL**4
00505      IF FEST-ADDRESS-AREA = SPACES OR LOW-VALUES                     CL236
00506         SET WRK-MTAD-T002-NO-88 TO TRUE                              CL120
00507         MOVE MSG4-ID            TO F907-MSG-ID                       CL*55
00508         MOVE MSG4-TEXT          TO F907-MSG-TEXT                     CL*55
00509         PERFORM S946-ERROR      THRU S946-EXIT                       CL*55
00510         GO TO P1300-EXIT.                                            CL238
00511                                                                      CL236
00512      MOVE SPACES                TO L072-ADDRESS.                     CL237
00513      MOVE 'Y'                   TO L072-CASS-IND.                    CL110
00514      SET L072-MTAD-88 TO TRUE.                                       CL236
00515      MOVE MPRF-PRIMARY-NAME     TO L072-NAME.                        CL237
00516      MOVE FEST-ATTN-LINE        TO L072-ATTN-LINE.                   CL237
00517      MOVE FEST-STREET-ADDRESS-1 TO L072-DELIV-LINE-1.                CL236
00518      MOVE FEST-STREET-ADDRESS-2 TO L072-DELIV-LINE-2.                CL236
00519      MOVE FEST-CITY             TO L072-CITY.                        CL237
00520      MOVE FEST-STATE            TO L072-ST.                          CL237
00521      MOVE FEST-ZIP              TO L072-ZIP.                         CL237
00522                                                                      CL*27
00523      PERFORM S072-ADDRESS-EDIT THRU S072-EXIT.                       CL236
00524                                                                      CL120
00525      IF L072-ADDRESS-NOT-VALID-88                                    CL*46
00526         DISPLAY 'L072 ADDRESS INVALID ' L072-MSG-AREA                CL120
00527         SET WRK-MTAD-T002-NO-88 TO TRUE                              CL*47
00528         MOVE MSG4-ID            TO F907-MSG-ID                       CL*46
00529         MOVE MSG4-TEXT          TO F907-MSG-TEXT                     CL*46
00530         MOVE FEST-STREET-ADDRESS-2 TO WRK-ERROR-ADDR                 CL*91
00531         MOVE FEST-CITY             TO WRK-ERROR-CITY                 CL*91
00532         MOVE FEST-STATE            TO WRK-ERROR-STATE                CL*91
00533         MOVE FEST-ZIP              TO WRK-ERROR-ZIP                  CL*91
00534         MOVE ERROR-ADDRESS-AREA    TO F907-GOV1-REC-ERR              CL*93
00535         PERFORM S946-ERROR         THRU S946-EXIT                    CL*91
00536         GO TO P1300-EXIT.                                            CL*46
00537                                                                      CL239
00538         MOVE L072-ATTN-LINE         TO T002-BSNS-ATTN.               CL121
00539         MOVE L072-DELIV-LINE-1      TO T002-BSNS-DELV1.              CL121
00540         MOVE L072-DELIV-LINE-2      TO T002-BSNS-DELV2.              CL121
00541         MOVE L072-CITY              TO T002-BSNS-CITY.               CL121
00542         MOVE L072-ST                TO T002-BSNS-ST.                 CL121
00543         MOVE L072-ZIP               TO T002-BSNS-ZIP.                CL121
00544                                                                      CL115
00545  P1300-EXIT.                                                         CL120
00546      EXIT.                                                           CL120
00547                                                                      CL120
00548  P1600-CHECK-FEST-DATA.                                              CL120
00549                                                                      CL120
00550      IF FEST-BUSINESS-PHONE > SPACES                                 CL120
00551         MOVE FEST-BUSINESS-PHONE   TO T002-BUSINESS-VOICE            CL120
00552 *RW1                                                                 CL144
00553 *     (THIS IS THE BUSINESS !!!)      R120-CONTACT-PHONE             CL145
00554 *RW2                                                                 CL144
00555      ELSE                                                            CL120
00556         MOVE SPACES                TO T002-BUSINESS-VOICE.           CL120
00557                                                                      CL*18
00558      IF FEST-FAX   > SPACES                                          CL120
00559         MOVE FEST-FAX              TO T002-BUSINESS-FAX              CL120
00560      ELSE                                                            CL120
00561         MOVE SPACES                TO T002-BUSINESS-FAX.             CL120
00562                                                                      CL*19
00563       IF FEST-EMAIL-ADDRESS > SPACES                                 CL120
00564          MOVE FEST-EMAIL-ADDRESS   TO T002-BUSINESS-EMAIL            CL120
00565      ELSE                                                            CL120
00566          MOVE SPACES               TO T002-BUSINESS-EMAIL.           CL120
00567                                                                      CL*19
00568  P1600-EXIT.                                                         CL*19
00569      EXIT.                                                           CL*19
00570                                                                      CL*18
00571  P1700-WRITE-MTAD-T002.                                              CL134
00572                                                                      CL137
00573      DISPLAY ' WRITING T002 STATUS REC ' T002-EMP-NO.                CL137
00574                                                                      CL137
00575      IF WRK-MTAD-T002-NO-88                                          CL137
00576         GO TO P1700-EXIT.                                            CL137
00577                                                                      CL137
00578      MOVE MPRF-EMP-NO               TO T002-EMP-NO.                  CL237
00579      MOVE 'AUTOSTATUS'              TO T002-ORIGIN.                  CL237
00580      MOVE L005-DATE                 TO T002-SYS-DATE.                CL237
00581      MOVE L005-TIME                 TO T002-SYS-TIME.                CL237
00582      SET T002-UPD-MAIL-ADDR-88      TO TRUE.                         CL237
00583                                                                      CL237
00584      MOVE T002-REC               TO TSKL-REC.                        CL239
00585      PERFORM S927B-WRITE         THRU S927B-EXIT                     CL239
00586      ADD +1  TO WRK-T002-ADDR-CNT.                                   CL240
00587                                                                      CL237
00588  P1700-EXIT.                                                         CL*18
00589      EXIT.                                                           CL237
00590                                                                      CL237
00591 **************************************************************       CL*37
00592 *  USING THE MPRF EMP-NO TO FIND MOPO RECORD.                *       CL135
00593 **************************************************************       CL*37
00594                                                                      CL176
00595  P2000-MOPO.                                                         CL239
00596                                                                      CL*17
00597      MOVE LOW-VALUES  TO MOPO-KEY-AREA.                              CL176
00598      MOVE MPRF-EMP-NO TO MOPO-EMP-NO.                                CL176
00599      SET MOPO-OPO-88  TO TRUE.                                       CL176
00600      MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA.                            CL176
00601                                                                      CL176
00602      PERFORM S910-START-BROWSE THRU S910-EXIT.                       CL176
00603      IF L910-NO-REC-88                                               CL176
00604         NEXT SENTENCE                                                CL238
00605      ELSE                                                            CL176
00606         PERFORM                                                      CL176
00607           UNTIL L910-NO-REC-88                                       CL176
00608           OR WRK-MOPO-FOUND-YES-88                                   CL176
00609              MOVE MSKL-REC             TO MOPO-REC                   CL*78
00610              IF MOPO-TYPE-STATUS-88                                  CL*75
00611                 MOVE MOPO-REC TO MSKL-REC                            CL*79
00612                 SET WRK-MOPO-FOUND-YES-88   TO TRUE                  CL192
00613              ELSE                                                    CL192
00614                 PERFORM S910-READ-NEXT   THRU S910-EXIT              CL176
00615              END-IF                                                  CL176
00616         END-PERFORM                                                  CL176
00617      END-IF.                                                         CL176
00618                                                                      CL**1
00619                                                                      CL179
00620  P2000-EXIT.                                                         CL239
00621      EXIT.                                                           CL176
00622                                                                      CL135
00623  P2100-CONT-NAME.                                                    CL*20
00624       SET WRK-CONT-T002-YES-88 TO TRUE                               CL118
00625       MOVE FEST-CONTACT-FIRST-NAME   TO L076-NAMEF                   CL125
00626       MOVE FEST-CONTACT-MI           TO L076-NAMEI                   CL125
00627       MOVE FEST-CONTACT-LAST-NAME    TO L076-NAMEL                   CL125
00628                                                                      CL*28
00629       PERFORM S076-NAME           THRU S076-EXIT                     CL125
00630                                                                      CL*28
00631        IF L076-NAME-INVALID                                          CL125
00632          MOVE '061'              TO F907-MSG-ID                      CL139
00633          MOVE L076-NAME-GROUP    TO F907-GOV1-DATA                   CL133
00634          MOVE EFT061             TO F907-MSG-TEXT                    CL139
00635          PERFORM S946-ERROR      THRU S946-EXIT                      CL*20
00636          MOVE SPACES             TO F907-GOV1-DATA                   CL*72
00637          MOVE SPACES             TO T002-CONTACT-NAME                CL*20
00638 *RW1                                                                 CL144
00639          MOVE SPACES             TO R120-CONTACT-NAME                CL144
00640 *RW2                                                                 CL144
00641          SET WRK-CONT-T002-NO-88 TO TRUE                             CL118
00642          DISPLAY ' INV CONT NAME NO T002 CREATED' FEST-EMP-NO        CL118
00643        ELSE                                                          CL118
00644          DISPLAY ' L076 NAME STATUS CONT NAME   ' L076-NAM           CL126
00645          MOVE L076-NAM           TO T002-CONTACT-NAME                CL142
00646                                     R120-CONTACT-NAME.               CL142
00647                                                                      CL*28
00648  P2100-EXIT.                                                         CL*20
00649      EXIT.                                                           CL*20
00650                                                                      CL*20
00651                                                                      CL*20
00652  P2300-WRITE-CONT-T002.                                              CL*81
00653                                                                      CL118
00654      MOVE SPACES                    TO TSKL-REC.                     CL118
00655                                                                      CL118
00656      MOVE MPRF-EMP-NO               TO T002-EMP-NO.                  CL*20
00657      MOVE 'AUTOSTATUS'              TO T002-ORIGIN.                  CL*20
00658      MOVE L005-DATE                 TO T002-SYS-DATE.                CL*20
00659      MOVE L005-TIME                 TO T002-SYS-TIME.                CL*20
00660      MOVE ZEROS                     TO T002-CONTACT-SSN.             CL118
00661      MOVE SPACES                    TO T002-CONTACT-TITLE.           CL118
00662      MOVE SPACES                    TO T002-CONTACT-FAX.             CL118
00663      MOVE SPACES                    TO T002-CONTACT-EMAIL.           CL118
00664      MOVE FEST-CONTACT-AREA-CD      TO T002-C-VOICE-AREA-CD.         CL119
00665      MOVE FEST-CONTACT-PREFIX       TO T002-C-VOICE-PREFIX.          CL119
00666      MOVE FEST-CONTACT-SUFFIX       TO T002-C-VOICE-SUFFIX.          CL119
00667      MOVE FEST-CONTACT-EXT          TO T002-C-VOICE-EXT.             CL119
00668                                                                      CL*20
00669      IF WRK-MOPO-FOUND-YES-88                                        CL*20
00670         SET T002-UPD-CONTACT-88     TO TRUE                          CL*20
00671      ELSE                                                            CL*20
00672         SET T002-ADD-CONTACT-88     TO TRUE                          CL*20
00673      END-IF.                                                         CL*20
00674                                                                      CL*20
00675      SET T002-CONTACT-STATUS-88     TO TRUE.                         CL*76
00676                                                                      CL*20
00677      MOVE T002-REC               TO TSKL-REC.                        CL*20
00678      PERFORM S927B-WRITE         THRU S927B-EXIT.                    CL*20
00679      ADD +1  TO WRK-T002-CONTACT-CNT.                                CL*20
00680                                                                      CL*81
00681                                                                      CL118
00682  P2300-EXIT.                                                         CL*20
00683      EXIT.                                                           CL*20
00684                                                                      CL*20
00685 **************************************************************       CL207
00686 *  IF FEST SALE DATE, LAST WAGES PAID DATE, OR STATUS CHANGE *       CL209
00687 *  DESCRIPTION FIELDS CONTAIN DATA, PRINT A STATUS CHANGE    *       CL207
00688 *  REPORT RECORD.                                            *       CL207
00689 **************************************************************       CL207
00690                                                                      CL207
00691  P3000-STATUS-SALES.                                                 CL*21
00692                                                                      CL207
00693      IF FEST-SALE-DATE NUMERIC                                       CL106
00694         IF FEST-SALE-DATE > ZEROS                                    CL106
00695            MOVE FEST-SALE-DATE         TO R120-SALE-DATE             CL106
00696            SET WRK-STATUS-CHNG-YES-88  TO TRUE                       CL106
00697         ELSE                                                         CL106
00698            MOVE ZEROS                  TO R120-SALE-DATE             CL106
00699         END-IF                                                       CL106
00700      ELSE                                                            CL106
00701         MOVE FEST-SALE-DATE            TO R120-SALE-DATE             CL106
00702      END-IF.                                                         CL106
00703                                                                      CL106
00704  P3000-EXIT.                                                         CL*21
00705      EXIT.                                                           CL*21
00706                                                                      CL*21
00707  P3100-STATUS-PAID.                                                  CL*21
00708                                                                      CL209
00709      IF FEST-LAST-WAGES-PAID-DATE NUMERIC                            CL106
00710         IF FEST-LAST-WAGES-PAID-DATE > ZEROS                         CL106
00711            MOVE FEST-LAST-WAGES-PAID-DATE TO                         CL106
00712              R120-LAST-WAGES-PAID-DATE                               CL106
00713            SET WRK-STATUS-CHNG-YES-88 TO TRUE                        CL106
00714         ELSE                                                         CL106
00715            MOVE ZEROS TO R120-LAST-WAGES-PAID-DATE                   CL106
00716         END-IF                                                       CL106
00717      ELSE                                                            CL106
00718         MOVE FEST-LAST-WAGES-PAID-DATE TO                            CL106
00719           R120-LAST-WAGES-PAID-DATE                                  CL106
00720      END-IF.                                                         CL209
00721                                                                      CL209
00722  P3100-EXIT.                                                         CL*21
00723      EXIT.                                                           CL*21
00724                                                                      CL*21
00725  P3200-STATUS-DESC.                                                  CL*21
00726      IF FEST-STATUS-CHG-DESCRIPTION NOT = SPACES                     CL209
00727         MOVE FEST-STATUS-CHG-DESCRIPTION TO                          CL209
00728                R120-STATUS-CHNG-DESC                                 CL*23
00729         SET WRK-STATUS-CHNG-YES-88     TO TRUE                       CL241
00730      ELSE                                                            CL221
00731         MOVE SPACES                    TO R120-STATUS-CHNG-DESC      CL*23
00732      END-IF.                                                         CL209
00733                                                                      CL209
00734  P3200-EXIT.                                                         CL*21
00735      EXIT.                                                           CL*21
00736                                                                      CL*36
00737  P3300-STATUS-FEIN.                                                  CL*36
00738 *    IF FEST-FEIN > ZEROS                                            CL101
00739      MOVE MPRF-FEIN TO WRK-MPRF-FEIN                                 CL103
00740      IF FEST-FEIN NOT = WRK-MPRF-FEIN                                CL102
00741         MOVE FEST-FEIN TO R120-FEIN                                  CL140
00742         SET WRK-STATUS-CHNG-YES-88   TO TRUE                         CL140
00743      ELSE                                                            CL*36
00744         MOVE ZEROS                  TO R120-FEIN                     CL140
00745      END-IF.                                                         CL*36
00746                                                                      CL*36
00747  P3300-EXIT.                                                         CL*36
00748      EXIT.                                                           CL*36
00749                                                                      CL*36
00750  P3400-STATUS-TRACE.                                                 CL*36
00751      IF FEST-TRACE-NO > ZEROS                                        CL*36
00752         MOVE FEST-TRACE-NO TO R120-TRACE-NO                          CL*36
00753         SET WRK-STATUS-CHNG-YES-88     TO TRUE                       CL*36
00754      ELSE                                                            CL*36
00755         MOVE ZEROS                     TO R120-TRACE-NO              CL*36
00756      END-IF.                                                         CL*36
00757                                                                      CL*36
00758  P3400-EXIT.                                                         CL*36
00759      EXIT.                                                           CL*36
00760                                                                      CL*21
00761  P3500-WRITE-R120.                                                   CL*36
00762      MOVE '120'              TO R120-REC-TYPE.                       CL105
00763      MOVE MPRF-EMP-NO        TO R120-EMP-NO                          CL105
00764 *RW1                                                                 CL147
00765      IF MPRF-PRIMARY-IS-ENTITY-88                                    CL147
00766         IF FEST-ENTITY-NAME  NOT = MPRF-PRIMARY-NAME                 CL147
00767            IF FEST-ENTITY-NAME <= SPACES                             CL147
00768               MOVE SPACES            TO R120-ENTITY-NAME             CL147
00769            ELSE                                                      CL147
00770               MOVE FEST-ENTITY-NAME  TO R120-ENTITY-NAME             CL147
00771            END-IF                                                    CL147
00772         ELSE                                                         CL147
00773            MOVE SPACES               TO R120-ENTITY-NAME             CL147
00774         END-IF                                                       CL147
00775      ELSE                                                            CL147
00776         IF FEST-ENTITY-NAME  NOT = MPRF-ENTITY-NAME                  CL147
00777            IF FEST-ENTITY-NAME <= SPACES                             CL147
00778               MOVE SPACES            TO R120-ENTITY-NAME             CL147
00779            ELSE                                                      CL147
00780               MOVE FEST-ENTITY-NAME  TO R120-ENTITY-NAME             CL147
00781            END-IF                                                    CL147
00782         ELSE                                                         CL147
00783            MOVE SPACES               TO R120-ENTITY-NAME             CL147
00784         END-IF                                                       CL147
00785      END-IF.                                                         CL147
00786                                                                      CL147
00787      IF FEST-CONTACT-PHONE > SPACES                                  CL144
00788         MOVE FEST-CONTACT-AREA-CD   TO R120-VOICE-AREA-CD            CL144
00789         MOVE FEST-CONTACT-PREFIX    TO R120-VOICE-PREFIX             CL144
00790         MOVE FEST-CONTACT-SUFFIX    TO R120-VOICE-SUFFIX             CL144
00791         MOVE FEST-CONTACT-EXT       TO R120-VOICE-EXT                CL144
00792      ELSE                                                            CL144
00793         MOVE SPACES TO R120-CONTACT-PHONE.                           CL144
00794 *RW2                                                                 CL144
00795      MOVE R120-REC           TO RSKL-REC                             CL105
00796      PERFORM S946-RPT-O THRU S946-EXIT                               CL105
00797      ADD +1  TO WRK-R120-WRITE-CNT.                                  CL105
00798                                                                      CL226
00799  P3500-EXIT.                                                         CL*36
00800      EXIT.                                                           CL207
00801                                                                      CL207
00802  T0000-TERMINATE.                                                    CL146
00803                                                                      CL212
00804      DISPLAY ' '.                                                    CL221
00805      DISPLAY ' '.                                                    CL221
00806                                                                      CL*71
00807      DISPLAY '*** EFTBD120 TERMINATION STATISTICS ***'.              CL243
00808                                                                      CL*71
00809      DISPLAY '  '.                                                   CL237
00810      DISPLAY ' EFT-STATUS-(01) RECS PASSED FROM BD100       :'       CL253
00811              WRK-STATUS-READ-CNT.                                    CL242
00812                                                                      CL*98
00813      DISPLAY ' '.                                                    CL205
00814                                                                      CL195
00815      DISPLAY ' T002 MTAD - BUSINESS TRANSACTIONS WRITTEN    :'       CL*37
00816              WRK-T002-ADDR-CNT.                                      CL240
00817                                                                      CL205
00818      DISPLAY ' T002 MOPO - CONTACT  TRANSACTIONS WRITTEN    :'       CL*41
00819              WRK-T002-CONTACT-CNT.                                   CL240
00820                                                                      CL205
00821      DISPLAY ' '.                                                    CL205
00822                                                                      CL210
00823      DISPLAY ' REPORT RECS TYPE(120) WRITTEN TO ERROR FILE  :'       CL*51
00824              WRK-R120-WRITE-CNT.                                     CL*21
00825                                                                      CL*41
00826      DISPLAY ' EDIT ERRORS TYPE(907) WRITTEN TO ERROR FILE  :'       CL*41
00827              WRK-R907-REC-CNT.                                       CL*41
00828                                                                      CL210
00829      DISPLAY ' '.                                                    CL210
00830                                                                      CL226
00831  T0000-EXIT.                                                         CL146
00832      EXIT.                                                           CL146
00833                                                                      CL*59
00834  S001-FROM-FED-8.                                                    CL108
00835      SET L001-FROM-FED-8 TO TRUE.                                    CL108
00836      GO TO S001-DATE.                                                CL108
00837                                                                      CL108
00838  S001-FROM-ABS-DAY.                                                  CL108
00839      SET L001-FROM-ABS-DAY TO TRUE.                                  CL108
00840      GO TO S001-DATE.                                                CL108
00841                                                                      CL108
00842  S001-FROM-CAL-6.                                                    CL108
00843      SET L001-FROM-CAL-6 TO TRUE.                                    CL108
00844      GO TO S001-DATE.                                                CL108
00845                                                                      CL108
00846  S001-DATE.                                                          CL108
00847      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL108
00848  S001-EXIT.                                                          CL108
00849      EXIT.                                                           CL108
00850                                                                      CL*15
00851  S004-FROM-3.                                                        CL*24
00852      SET L004-FROM-3        TO TRUE.                                 CL*24
00853      GO TO S004-YRQ.                                                 CL*24
00854                                                                      CL*24
00855  S004-YRQ.                                                           CL*24
00856      CALL 'DTSBU004' USING L004-LINK-AREA.                           CL*24
00857                                                                      CL*24
00858  S004-EXIT.                                                          CL*24
00859      EXIT.                                                           CL*24
00860                                                                      CL*24
00861  S005-SYS-DATE.                                                      CL*61
00862      CALL 'DTSBU005' USING L005-COMM-AREA.                           CL*61
00863                                                                      CL*61
00864  S005-EXIT.                                                          CL*61
00865      EXIT.                                                           CL*61
00866                                                                      CL*17
00867  S072-ADDRESS-EDIT.                                                  CL242
00868      CALL 'DTSBU072' USING L072-LINK-AREA.                           CL242
00869                                                                      CL242
00870  S072-EXIT.                                                          CL242
00871      EXIT.                                                           CL242
00872                                                                      CL*15
00873  S076-NAME.                                                          CL126
00874      CALL 'DTSBU076' USING L076-LINK-AREA.                           CL126
00875                                                                      CL*15
00876  S076-EXIT.                                                          CL126
00877      EXIT.                                                           CL*15
00878                                                                      CL*70
00879  S910-READ.                                                          CL*70
00880      SET L910-READ-88 TO TRUE.                                       CL*70
00881      GO TO S910-MSTR-IO.                                             CL*70
00882                                                                      CL*70
00883  S910-START-BROWSE.                                                  CL*70
00884      SET L910-START-BROWSE-88 TO TRUE.                               CL*70
00885      GO TO S910-MSTR-IO.                                             CL*70
00886                                                                      CL*13
00887  S910-READ-NEXT.                                                     CL*70
00888      SET L910-READ-NEXT-88 TO TRUE.                                  CL*70
00889      GO TO S910-MSTR-IO.                                             CL*70
00890                                                                      CL*70
00891  S910-COUNT.                                                         CL*70
00892      SET L910-COUNT-88 TO TRUE.                                      CL*70
00893      GO TO S910-MSTR-IO.                                             CL*70
00894                                                                      CL*70
00895  S910-MSTR-IO.                                                       CL*70
00896      CALL 'DTSBU910' USING L910-LINK-AREA                            CL*70
00897                            MSKL-REC.                                 CL*70
00898  S910-EXIT.                                                          CL*70
00899      EXIT.                                                           CL*70
00900                                                                      CL*80
00901  S927B-WRITE.                                                        CL238
00902      SET L927-WRITE-88 TO TRUE.                                      CL166
00903      CALL 'DTSBU927' USING L927-LINK-AREA                            CL238
00904                            TSKL-REC.                                 CL238
00905                                                                      CL238
00906  S927B-EXIT.                                                         CL238
00907      EXIT.                                                           CL238
00908                                                                      CL161
00909  S946-RPT-O.                                                         CL226
00910      CALL 'DTSBU946' USING RSKL-REC.                                 CL252
00911      GO TO S946-EXIT.                                                CL**6
00912                                                                      CL*42
00913  S946-ERROR.                                                         CL**6
00914       ADD +1            TO WRK-R907-REC-CNT.                         CL*43
00915       MOVE FEST-EMP-NO  TO F907-EMP-NO.                              CL**6
00916       MOVE '34'         TO F907-GOV1-RECID.                          CL*34
00917       MOVE 'EFTBD120 '  TO F907-MODULE-NAME.                         CL*42
00918       CALL 'DTSBU946' USING F907-REC.                                CL*42
00919                                                                      CL*42
00920  S946-EXIT.                                                          CL226
00921      EXIT.                                                           CL226
00922                                                                      CL226
00923  S999-ABEND.                                                         CL146
00924      DISPLAY '*** EFTBD120 ABENDING : '                              CL243
00925              WRK-ABEND-MSG.                                          CL*83
00926                                                                      CL146
00927      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL146
00928  S999-EXIT.                                                          CL146
00929      EXIT.                                                           CL146
00930                                                                      CL*42
