00001  IDENTIFICATION DIVISION.                                         07/26/02
00002  PROGRAM-ID.             DTSBR763.                                DTSBR763
00003  AUTHOR.                 TRW                                         LV042
00004  DATE-WRITTEN.           SEPTEMBER 1999                           DTSBR763
00005  DATE-COMPILED.                                                   DTSBR763
00006                                                                   DTSBR763
00007 *****                                                             DTSBR763
00008 *                                                                 DTSBR763
00009 *    FUNCTION:  LIST OF NEW EMPLOYERS WITHIN THE REPORTING PERIOD DTSBR763
00010 *               FOR JOB SERVICE.                                  DTSBR763
00011 *                                                                 DTSBR763
00012 *    CALLING SEQUENCE:   DTSBD400 CALLS DTSBE763                  DTSBR763
00013 *                            WHICH CREATES DTSIR763 RECORDS       DTSBR763
00014 *                        DTSBD800 CALLS DTSBR763                  DTSBR763
00015 *                            WHICH USES THE DTSIR763 RECORDS      DTSBR763
00016 *                            TO FORMAT AND PRINT THE REPORT       DTSBR763
00017 *                                                                 DTSBR763
00018 *    MODIFICATION HISTORY:                                        DTSBR763
00019 *                                                                 DTSBR763
00020 * 09-18-99 INITIAL DEVELOPMENT                                    DTSBR763
00021 *          REFERENCE DIR #00043           AUTHOR OF CHANGE - TKT  DTSBR763
00022 *                                                                 DTSBR763
00023 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR763
00024 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR763
00025 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR763
00026 *                                                                 DTSBR763
00027 *                                                                 DTSBR763
00028 *    DESCRIPTION:                                                 DTSBR763
00029 *                                                                 DTSBR763
00030 *        THIS MODULE REPORTS ON ALL EMPLOYERS WHO WERE REGISTERED DTSBR763
00031 *        WITHIN THE REPORTING PERIOD, ARE ACTIVE AS OF THE        DTSBR763
00032 *        EXTRACT RUN DATE, AND WHO EMPLOY AT LEAST 40 WORKERS.    DTSBR763
00033 *                                                                 DTSBR763
00034 *        THIS IS AN "AT LEAST ONCE" MODULE.                       DTSBR763
00035 *                                                                 DTSBR763
00036 *                                                                 DTSBR763
00037 *    RECORDS READ:                                                DTSBR763
00038 *                                                                 DTSBR763
00039 *        NONE.                                                    DTSBR763
00040 *                                                                 DTSBR763
00041 *                                                                 DTSBR763
00042 *    PRINTED OUTPUTS:                                             DTSBR763
00043 *                                                                 DTSBR763
00044 *        763R1  JOB SERVICE NEW EMPLOYERS LIST                    DTSBR763
00045 *                                                                 DTSBR763
00046 *                                                                 DTSBR763
00047 *    RECORDS WRITTEN:                                             DTSBR763
00048 *                                                                 DTSBR763
00049 *        NONE.                                                    DTSBR763
00050 *                                                                 DTSBR763
00051 *                                                                 DTSBR763
00052 *    MODULES CALLED:                                              DTSBR763
00053 *                                                                 DTSBR763
00054 *        NONE                                                     DTSBR763
00055 *                                                                 DTSBR763
00056 *                                                                 DTSBR763
00057 *****                                                             DTSBR763
00058                                                                   DTSBR763
00059  ENVIRONMENT DIVISION.                                            DTSBR763
00060                                                                   DTSBR763
00061  CONFIGURATION SECTION.                                           DTSBR763
00062  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR763
00063                                                                   DTSBR763
00064  INPUT-OUTPUT SECTION.                                            DTSBR763
00065                                                                   DTSBR763
00066  FILE-CONTROL.                                                    DTSBR763
00067      SELECT PRT-FILE ASSIGN TO RPT763R1.                          DTSBR763
00068                                                                   DTSBR763
00069  DATA DIVISION.                                                   DTSBR763
00070                                                                   DTSBR763
00071  FILE SECTION.                                                    DTSBR763
00072                                                                   DTSBR763
00073  FD  PRT-FILE                                                     DTSBR763
00074      RECORDING MODE IS F.                                         DTSBR763
00075  01  REPORT-LISTING1                 PIC  X(133).                 DTSBR763
00076                                                                   DTSBR763
00077  WORKING-STORAGE SECTION.                                         DTSBR763
000775 77  PAN-VALET PICTURE X(24) VALUE '042DTSBR763  07/26/02'.       DTSBR763
00078                                                                   DTSBR763
00079  01  WRK-AREA.                                                    DTSBR763
00080      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +763.DTSBR763
00081                                                                   DTSBR763
00082      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.  DTSBR763
00083      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.  DTSBR763
00084      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  DTSBR763
00085      05  WS-NUMBER-ONE               PIC S9(05) COMP-3 VALUE +0.  DTSBR763
00086                                                                   DTSBR763
00087      05  WS-VOICE-EXT-X.                                          DTSBR763
00088          10  FILLER                  PIC  X(01)        VALUE 'X'. DTSBR763
00089          10  WS-EXT                  PIC  X(04).                  DTSBR763
00090                                                                   DTSBR763
00091      05  WS-VOICE-EXT                PIC  X(05).                  DTSBR763
00092      05  WS-R763-EMP-STATUS          PIC  X(05) VALUE SPACES.     DTSBR763
00093                                                                   DTSBR763
00094      05  WS-IDXX                     PIC  X.                      DTSBR763
00095      05  WS-IDX REDEFINES WS-IDXX    PIC  9.                      DTSBR763
00096                                                                   DTSBR763
00097      05  FIRST-TIME-IND              PIC  X            VALUE 'Y'. DTSBR763
00098                                                                   DTSBR763
00099      05  WS-R763-VOICE.                                           DTSBR763
00100          10  R763-VOICE-AREA-CD      PIC  X(03).                  DTSBR763
00101          10  FILLER                  PIC  X            VALUE '-'. DTSBR763
00102          10  R763-VOICE-PREFIX       PIC  X(03).                  DTSBR763
00103          10  FILLER                  PIC  X            VALUE '-'. DTSBR763
00104          10  R763-VOICE-SUFFIX       PIC  X(04).                  DTSBR763
00105                                                                   DTSBR763
00106      05  WS-VOICE                    PIC  X(12).                  DTSBR763
00107                                                                   DTSBR763
00108  01  L001-LINK-AREA.                                              DTSBR763
00109  ++INCLUDE DTSIL001                                               DTSBR763
00110      EJECT                                                        DTSBR763
00111  01  L112-LINK-AREA.                                              DTSBR763
00112  ++INCLUDE DTSIL112                                               DTSBR763
00113      EJECT                                                        DTSBR763
00114                                                                   DTSBR763
00115  01  PAGE-HEADING.                                                DTSBR763
00116      05  HDR-LINE-1.                                              DTSBR763
00117          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR763
00118          10  FILLER                  PIC  X(05)                   DTSBR763
00119                 VALUE '763R1'.                                    DTSBR763
00120          10  FILLER                  PIC  X(35)  VALUE SPACES.    DTSBR763
00121          10  HDR-AGY-NAME-LINE1      PIC  X(50).                  DTSBR763
00122          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR763
00123          10  FILLER                  PIC  X(05)                   DTSBR763
00124                 VALUE 'DATE:'.                                    DTSBR763
00125          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR763
00126          10  HDR-SYS-DATE            PIC  X(08).                  DTSBR763
00127                                                                   DTSBR763
00128      05  HDR-LINE-2.                                              DTSBR763
00129          10  FILLER                  PIC  X(41)  VALUE SPACES.    DTSBR763
00130          10  HDR-AGY-NAME-LINE2      PIC  X(50).                  DTSBR763
00131          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR763
00132          10  FILLER                  PIC  X(05)                   DTSBR763
00133                 VALUE 'TIME:'.                                    DTSBR763
00134          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR763
00135          10  HDR-SYS-TIME            PIC  X(08).                  DTSBR763
00136                                                                   DTSBR763
00137      05  HDR-LINE-3.                                              DTSBR763
00138          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR763
00139          10  FILLER                  PIC  X(33)                   DTSBR763
00140                 VALUE 'ROUTE TO:  JOB SERVICE           '.        DTSBR763
00141          10  FILLER                  PIC  X(85)  VALUE SPACES.    DTSBR763
00142          10  FILLER                  PIC  X(05)                   DTSBR763
00143                 VALUE 'PAGE:'.                                    DTSBR763
00144          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR763
00145          10  HDR-PAGE-CNT            PIC  ZZ,ZZ9.                 DTSBR763
00146                                                                   DTSBR763
00147      05  HDR-LINE-4.                                              DTSBR763
00148          10  FILLER                  PIC  X(44)  VALUE SPACES.    DTSBR763
00149          10  FILLER                  PIC  X(32)                   DTSBR763
00150                 VALUE 'JOB SERVICE NEW AND REACTIVATED '.         DTSBR763
00151          10  FILLER                  PIC  X(14)                   DTSBR763
00152                 VALUE 'EMPLOYERS LIST'.                           DTSBR763
00153                                                                   DTSBR763
00154      05  HDR-LINE-5.                                              DTSBR763
00155          10  FILLER                  PIC  X(54)  VALUE SPACES.    DTSBR763
00156          10  WS-START-DT             PIC  X(10).                  DTSBR763
00157          10  FILLER                  PIC  X(06)                   DTSBR763
00158                 VALUE ' THRU '.                                   DTSBR763
00159          10  WS-END-DT               PIC  X(10).                  DTSBR763
00160                                                                   DTSBR763
00161      05  HDR-LINE-6                  PIC  X(133) VALUE SPACES.    DTSBR763
00162                                                                   DTSBR763
00163      05  HDR-LINE-7.                                              DTSBR763
00164          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR763
00165          10  FILLER                  PIC  X(08)                   DTSBR763
00166                 VALUE 'INDUSTRY'.                                 DTSBR763
00167          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBR763
00168          10  FILLER                  PIC  X(12)                   DTSBR763
00169                 VALUE 'PRIMARY NAME'.                             DTSBR763
00170          10  FILLER                  PIC  X(30)  VALUE SPACES.    DTSBR763
00171          10  FILLER                  PIC  X(15)                   DTSBR763
00172                 VALUE 'MAILING ADDRESS'.                          DTSBR763
00173          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR763
00174          10  FILLER                  PIC  X(16)                   DTSBR763
00175                 VALUE 'TELEPHONE NUMBER'.                         DTSBR763
00176                                                                   DTSBR763
00177      05  HDR-LINE-8.                                              DTSBR763
00178          10  FILLER                  PIC  X(25)  VALUE SPACES.    DTSBR763
00179          10  FILLER                  PIC  X(11)                   DTSBR763
00180                 VALUE 'EMP ACCT NO'.                              DTSBR763
00181          10  FILLER                  PIC  X(08)  VALUE SPACES.    DTSBR763
00182          10  FILLER                  PIC  X(09)                   DTSBR763
00183                 VALUE 'NEW/REACT'.                                DTSBR763
00184      05  HDR-LINE-9                  PIC  X(133) VALUE SPACES.    DTSBR763
00185                                                                   DTSBR763
00186  01  DETAIL-LINE-1.                                               DTSBR763
00187      05  DTL1-LINE-2.                                             DTSBR763
00188          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBR763
00189          10  DTL1-INDUSTRY-CODE      PIC  X(06).                  DTSBR763
00190          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR763
00191          10  DTL1-PRIMARY-NAME       PIC  X(40).                  DTSBR763
00192          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR763
00193          10  DTL1-MAILING-LINE-1     PIC  X(40).                  DTSBR763
00194          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR763
00195          10  DTL1-VOICE              PIC  X(12).                  DTSBR763
00196          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR763
00197          10  DTL1-VOICE-EXT          PIC  X(05).                  DTSBR763
00198                                                                   DTSBR763
00199  01  DETAIL-LINE-2.                                               DTSBR763
00200      05  DTL2-LINE-1.                                             DTSBR763
00201          10  FILLER                  PIC  X(27)  VALUE SPACES.    DTSBR763
00202          10  DTL2-EMP-NO             PIC  999B999.                DTSBR763
00203          10  FILLER                  PIC  X(11)  VALUE SPACES.    DTSBR763
00204          10  DTL2-EMP-STATUS         PIC  X(05).                  DTSBR763
00205          10  FILLER                  PIC  X(09)  VALUE SPACES.    DTSBR763
00206          10  DTL2-MAILING-LINE-2     PIC  X(40).                  DTSBR763
00207                                                                   DTSBR763
00208  01  DETAIL-LINE-3.                                               DTSBR763
00209      05  DTL3-LINE-1.                                             DTSBR763
00210          10  FILLER                  PIC  X(59)  VALUE SPACES.    DTSBR763
00211          10  DTL3-MAILING-LINE-3     PIC  X(40).                  DTSBR763
00212                                                                   DTSBR763
00213  01  DETAIL-LINE-4.                                               DTSBR763
00214      05  DTL4-LINE-1.                                             DTSBR763
00215          10  FILLER                  PIC  X(59)  VALUE SPACES.    DTSBR763
00216          10  DTL4-MAILING-LINE-4     PIC  X(40).                  DTSBR763
00217                                                                   DTSBR763
00218  01  DETAIL-LINE-5.                                               DTSBR763
00219      05  DTL5-LINE-1.                                             DTSBR763
00220          10  FILLER                  PIC  X(59)  VALUE SPACES.    DTSBR763
00221          10  DTL5-MAILING-LINE-5     PIC  X(40).                  DTSBR763
00222                                                                   DTSBR763
00223  01  CONTROL-FOOTING-FINAL.                                       DTSBR763
00224      05  CFF-LINE-2.                                              DTSBR763
00225          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR763
00226          10  FILLER                  PIC  X(38)                   DTSBR763
00227                 VALUE 'TOTAL NUMBER OF NEW EMPLOYERS WITH AT '.   DTSBR763
00228          10  FILLER                  PIC  X(18)                   DTSBR763
00229                 VALUE 'LEAST 40 WORKERS: '.                       DTSBR763
00230          10  CFF-NUMBER-ONE          PIC  ZZ,ZZ9.                 DTSBR763
00231                                                                   DTSBR763
00232      05  CFF-LINE-6.                                              DTSBR763
00233          10  FILLER                  PIC  X(31)  VALUE SPACES.    DTSBR763
00234          10  FILLER                  PIC  X(17)                   DTSBR763
00235                 VALUE '*** END OF REPORT'.                        DTSBR763
00236      EJECT                                                        DTSBR763
00237  LINKAGE SECTION.                                                 DTSBR763
00238                                                                   DTSBR763
00239  01  LRCM-LINK-AREA.                                              DTSBR763
00240  ++INCLUDE DTSILRCM                                               DTSBR763
00241      EJECT                                                        DTSBR763
00242  01  R763-REC.                                                    DTSBR763
00243  ++INCLUDE DTSIR763                                               DTSBR763
00244      EJECT                                                        DTSBR763
00245  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR763
00246                           R763-REC.                               DTSBR763
00247                                                                   DTSBR763
00248      IF FIRST-TIME-IND = 'Y'                                      DTSBR763
00249          PERFORM I1000-INITIATE                                   DTSBR763
00250             THRU I1000-EXIT                                       DTSBR763
00251          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR763
00252                                                                   DTSBR763
00253      IF LRCM-EOR-88                                               DTSBR763
00254          PERFORM T1000-TERMINATE                                  DTSBR763
00255             THRU T1000-EXIT                                       DTSBR763
00256      ELSE                                                         DTSBR763
00257          PERFORM P1000-PROCESS                                    DTSBR763
00258             THRU P1000-EXIT.                                      DTSBR763
00259                                                                   DTSBR763
00260      GOBACK.                                                      DTSBR763
00261                                                                   DTSBR763
00262  I1000-INITIATE.                                                  DTSBR763
00263                                                                   DTSBR763
00264      MOVE R763-START-DT     TO L001-FED-8-DATE-9.                 DTSBR763
00265      PERFORM S001-FROM-FED-8                                      DTSBR763
00266         THRU S001-EXIT.                                           DTSBR763
00267      MOVE L001-SLASH-8-DATE TO WS-START-DT.                       DTSBR763
00268                                                                   DTSBR763
00269      MOVE R763-END-DT       TO L001-FED-8-DATE-9.                 DTSBR763
00270      PERFORM S001-FROM-FED-8                                      DTSBR763
00271         THRU S001-EXIT.                                           DTSBR763
00272      MOVE L001-SLASH-8-DATE TO WS-END-DT.                         DTSBR763
00273                                                                   DTSBR763
00274      OPEN OUTPUT PRT-FILE.                                        DTSBR763
00275      MOVE LRCM-SYS-DATE TO HDR-SYS-DATE.                          DTSBR763
00276      MOVE LRCM-SYS-TIME TO HDR-SYS-TIME.                          DTSBR763
00277      MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1.              DTSBR763
00278      MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2.              DTSBR763
00279      MOVE SPACES TO REPORT-LISTING1.                              DTSBR763
00280                                                                   DTSBR763
00281  I1000-EXIT.                                                      DTSBR763
00282      EXIT.                                                        DTSBR763
00283                                                                   DTSBR763
00284  P1000-PROCESS.                                                   DTSBR763
00285                                                                   DTSBR763
00286      SET  L112-TAD-ADDR-88      TO TRUE.                          DTSBR763
00287      SET  L112-ANCHOR-FIRST-88  TO TRUE                           DTSBR763
00288      MOVE R763-PRIMARY-NAME     TO L112-PRIMARY-NAME.             DTSBR763
00289      MOVE SPACES                TO L112-NAME.                     DTSBR763
00290      MOVE SPACES                TO L112-TITLE.                    DTSBR763
00291                                                                   DTSBR763
00292      MOVE R763-ADDRESS          TO L112-ADDRESS.                  DTSBR763
00293      PERFORM S112-FORMAT-ADDR                                     DTSBR763
00294         THRU S112-EXIT.                                           DTSBR763
00295                                                                   DTSBR763
00296      PERFORM                                                      DTSBR763
00297        UNTIL L112-MAILING-LINE-1 NOT = SPACES                     DTSBR763
00298          PERFORM                                                  DTSBR763
00299            VARYING L112-MAILING-IDX FROM 1 BY 1                   DTSBR763
00300              UNTIL L112-MAILING-IDX > 4                           DTSBR763
00301               MOVE L112-MAILING-LINE (L112-MAILING-IDX + 1)       DTSBR763
00302                 TO L112-MAILING-LINE (L112-MAILING-IDX)           DTSBR763
00303          END-PERFORM                                              DTSBR763
00304          MOVE SPACES TO L112-MAILING-LINE-5                       DTSBR763
00305      END-PERFORM.                                                 DTSBR763
00306                                                                   DTSBR763
00307      PERFORM                                                      DTSBR763
00308        VARYING L112-MAILING-IDX FROM 1 BY 1                       DTSBR763
00309          UNTIL L112-MAILING-IDX > 5                               DTSBR763
00310            IF  L112-MAILING-LINE (L112-MAILING-IDX) > SPACES      DTSBR763
00311                SET WS-IDX TO L112-MAILING-IDX                     DTSBR763
00312                EVALUATE WS-IDXX                                   DTSBR763
00313                  WHEN '1'                                         DTSBR763
00314                    PERFORM P2000-TELEPHONE-CHECK THRU P2000-EXIT  DTSBR763
00315                    MOVE R763-INDUSTRY-CODE  TO DTL1-INDUSTRY-CODE DTSBR763
00316                    MOVE R763-PRIMARY-NAME   TO DTL1-PRIMARY-NAME  DTSBR763
00317                    MOVE L112-MAILING-LINE-1 TO DTL1-MAILING-LINE-1DTSBR763
00318                    MOVE WS-VOICE            TO DTL1-VOICE         DTSBR763
00319                    MOVE WS-VOICE-EXT        TO DTL1-VOICE-EXT     DTSBR763
00320                    PERFORM P4000-PRINT-HEADER THRU P4000-EXIT     DTSBR763
00321                    WRITE REPORT-LISTING1 FROM DTL1-LINE-2 AFTER 2 DTSBR763
00322                    ADD +2    TO WS-LINE-CNT2                      DTSBR763
00323                    ADD +1    TO WS-NUMBER-ONE                     DTSBR763
00324                  WHEN '2'                                         DTSBR763
00325                    PERFORM P3000-STATUS-CHECK THRU P3000-EXIT     DTSBR763
00326                    MOVE R763-EMP-NO         TO DTL2-EMP-NO        DTSBR763
00327                    MOVE WS-R763-EMP-STATUS  TO DTL2-EMP-STATUS    DTSBR763
00328                    MOVE L112-MAILING-LINE-2 TO DTL2-MAILING-LINE-2DTSBR763
00329                    PERFORM P4000-PRINT-HEADER THRU P4000-EXIT     DTSBR763
00330                    WRITE REPORT-LISTING1 FROM DTL2-LINE-1 AFTER 1 DTSBR763
00331                    ADD +1    TO WS-LINE-CNT2                      DTSBR763
00332                  WHEN '3'                                         DTSBR763
00333                    MOVE L112-MAILING-LINE-3 TO DTL3-MAILING-LINE-3DTSBR763
00334                    PERFORM P4000-PRINT-HEADER THRU P4000-EXIT     DTSBR763
00335                    WRITE REPORT-LISTING1 FROM DTL3-LINE-1 AFTER 1 DTSBR763
00336                    ADD +1    TO WS-LINE-CNT2                      DTSBR763
00337                  WHEN '4'                                         DTSBR763
00338                    MOVE L112-MAILING-LINE-4 TO DTL4-MAILING-LINE-4DTSBR763
00339                    PERFORM P4000-PRINT-HEADER THRU P4000-EXIT     DTSBR763
00340                    WRITE REPORT-LISTING1 FROM DTL4-LINE-1 AFTER 1 DTSBR763
00341                    ADD +1    TO WS-LINE-CNT2                      DTSBR763
00342                  WHEN '5'                                         DTSBR763
00343                    MOVE L112-MAILING-LINE-5 TO DTL5-MAILING-LINE-5DTSBR763
00344                    PERFORM P4000-PRINT-HEADER THRU P4000-EXIT     DTSBR763
00345                    WRITE REPORT-LISTING1 FROM DTL5-LINE-1 AFTER 1 DTSBR763
00346                    ADD +1    TO WS-LINE-CNT2                      DTSBR763
00347                END-EVALUATE                                       DTSBR763
00348            END-IF                                                 DTSBR763
00349      END-PERFORM.                                                 DTSBR763
00350  P1000-EXIT.                                                      DTSBR763
00351      EXIT.                                                        DTSBR763
00352                                                                   DTSBR763
00353  P2000-TELEPHONE-CHECK.                                           DTSBR763
00354                                                                   DTSBR763
00355      IF R763-VOICE NOT > SPACES                                   DTSBR763
00356          MOVE SPACES TO WS-VOICE                                  DTSBR763
00357      ELSE                                                         DTSBR763
00358          MOVE CORR R763-VOICE TO WS-R763-VOICE                    DTSBR763
00359          MOVE WS-R763-VOICE   TO WS-VOICE.                        DTSBR763
00360                                                                   DTSBR763
00361      IF R763-VOICE-EXT NOT > SPACES                               DTSBR763
00362          MOVE SPACES          TO WS-VOICE-EXT                     DTSBR763
00363      ELSE                                                         DTSBR763
00364          MOVE R763-VOICE-EXT  TO WS-EXT                           DTSBR763
00365          MOVE WS-VOICE-EXT-X  TO WS-VOICE-EXT.                    DTSBR763
00366                                                                   DTSBR763
00367  P2000-EXIT.                                                      DTSBR763
00368      EXIT.                                                        DTSBR763
00369                                                                   DTSBR763
00370  P3000-STATUS-CHECK.                                              DTSBR763
00371                                                                   DTSBR763
00372      IF R763-EMP-STATUS = 'N'                                     DTSBR763
00373          MOVE 'NEW  ' TO WS-R763-EMP-STATUS                       DTSBR763
00374      ELSE                                                         DTSBR763
00375          MOVE 'REACT' TO WS-R763-EMP-STATUS                       DTSBR763
00376      END-IF.                                                      DTSBR763
00377                                                                   DTSBR763
00378  P3000-EXIT.                                                      DTSBR763
00379      EXIT.                                                        DTSBR763
00380                                                                   DTSBR763
00381  P4000-PRINT-HEADER.                                              DTSBR763
00382                                                                   DTSBR763
00383      IF WS-LINE-CNT GREATER 56 OR                                 DTSBR763
00384           WS-LINE-CNT2 GREATER 56                                 DTSBR763
00385         MOVE +0          TO WS-LINE-CNT                           DTSBR763
00386         MOVE +0          TO WS-LINE-CNT2                          DTSBR763
00387         ADD  +1          TO WS-PAGE-CNT                           DTSBR763
00388         MOVE WS-PAGE-CNT TO HDR-PAGE-CNT                          DTSBR763
00389         WRITE REPORT-LISTING1 FROM HDR-LINE-1                     DTSBR763
00390                 AFTER TOP-OF-PAGE                                 DTSBR763
00391         WRITE REPORT-LISTING1 FROM HDR-LINE-2 AFTER 1             DTSBR763
00392         WRITE REPORT-LISTING1 FROM HDR-LINE-3 AFTER 1             DTSBR763
00393         WRITE REPORT-LISTING1 FROM HDR-LINE-4 AFTER 1             DTSBR763
00394         WRITE REPORT-LISTING1 FROM HDR-LINE-5 AFTER 1             DTSBR763
00395         WRITE REPORT-LISTING1 FROM HDR-LINE-6 AFTER 1             DTSBR763
00396         WRITE REPORT-LISTING1 FROM HDR-LINE-7 AFTER 1             DTSBR763
00397         WRITE REPORT-LISTING1 FROM HDR-LINE-8 AFTER 1             DTSBR763
00398         WRITE REPORT-LISTING1 FROM HDR-LINE-9 AFTER 1             DTSBR763
00399         ADD +9    TO WS-LINE-CNT2.                                DTSBR763
00400                                                                   DTSBR763
00401  P4000-EXIT.                                                      DTSBR763
00402      EXIT.                                                        DTSBR763
00403                                                                   DTSBR763
00404  T1000-TERMINATE.                                                 DTSBR763
00405                                                                   DTSBR763
00406      MOVE WS-NUMBER-ONE   TO CFF-NUMBER-ONE.                      DTSBR763
00407      WRITE REPORT-LISTING1 FROM CFF-LINE-2 AFTER 4.               DTSBR763
00408      WRITE REPORT-LISTING1 FROM CFF-LINE-6 AFTER 2.               DTSBR763
00409      CLOSE PRT-FILE.                                              DTSBR763
00410                                                                   DTSBR763
00411  T1000-EXIT.                                                      DTSBR763
00412      EXIT.                                                        DTSBR763
00413                                                                   DTSBR763
00414  S001-FROM-FED-8.                                                 DTSBR763
00415      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR763
00416      GO TO S001-DATE.                                             DTSBR763
00417                                                                   DTSBR763
00418  S001-DATE.                                                       DTSBR763
00419      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR763
00420  S001-EXIT.                                                       DTSBR763
00421                                                                   DTSBR763
00422  S112-FORMAT-ADDR.                                                DTSBR763
00423      CALL 'DTSBU112' USING L112-LINK-AREA.                        DTSBR763
00424  S112-EXIT.                                                       DTSBR763
00425      EXIT.                                                        DTSBR763
00426                                                                   DTSBR763
00427 *S999-ABEND.                                                      DTSBR763
00428 *    CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR763
00429 *S999-EXIT.                                                       DTSBR763
00430 *    EXIT.                                                        DTSBR763
00431                                                                   DTSBR763
