00001  IDENTIFICATION DIVISION.                                         09/27/99
00002  PROGRAM-ID.             DTSBE763.                                DTSBE763
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV014
00004  DATE-WRITTEN.           AUGUST 1994.                             DTSBE763
00005  DATE-COMPILED.                                                   DTSBE763
00006                                                                      CL**7
00007 *****                                                             DTSBE763
00008 *                                                                 DTSBE763
00009 *    CALLING SEQUENCE:  DTSBD400 CALLS                               CL**5
00010 *                       DTSBE763 WHICH UPDATES DTSIR763              CL**7
00011 *                       DTSBR763 READS DTSIR763 RECORDS.             CL**7
00012 *                                                                    CL**5
00013 *    FUNCTION:  JOB SERVICE NEW EMPLOYER LIST EXTRACT.               CL**7
00014 *                                                                 DTSBE763
00015 *                                                                 DTSBE763
00016 *    MODIFICATION LOG:                                            DTSBE763
00017 *                                                                 DTSBE763
00018 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00019 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00020 *              WORK ORDER:                      PROGRAMMER: XXX      CL**2
00021 *                                                                    CL**2
00022 *                                                                 DTSBE763
00023 *  DESCRIPTION:                                                   DTSBE763
00024 *                                                                 DTSBE763
00025 *                                                                 DTSBE763
00026 *    INITIATION:                                                  DTSBE763
00027 *                                                                 DTSBE763
00028 *      SET LECM-MST-OPEN-READ-88 TO TRUE.                         DTSBE763
00029 *      SET LECM-REF-OPEN-READ-88 TO TRUE.                         DTSBE763
00030 *                                                                 DTSBE763
00031 *      EDIT AND DEFAULT PARAMETERS.  SEE PRINTED OUTPUTS          DTSBE763
00032 *      DESCRIPTIONS AND LAYOUTS (763R1).                             CL**7
00033 *                                                                 DTSBE763
00034 *                                                                 DTSBE763
00035 *                                                                 DTSBE763
00036 *    PROCESSING:                                                  DTSBE763
00037 *                                                                 DTSBE763
00038 *      SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (763R1).          CL**7
00039 *                                                                 DTSBE763
00040 *                                                                 DTSBE763
00041 *    TERMINATION:                                                 DTSBE763
00042 *                                                                 DTSBE763
00043 *      NONE.                                                      DTSBE763
00044 *                                                                 DTSBE763
00045 *                                                                 DTSBE763
00046 *    RECORDS READ:                                                DTSBE763
00047 *                                                                 DTSBE763
00048 *      MASTER:                                                    DTSBE763
00049 *                                                                 DTSBE763
00050 *        MSOL                                                     DTSBE763
00051 *        MREL                                                     DTSBE763
00052 *                                                                 DTSBE763
00053 *                                                                 DTSBE763
00054 *      ALTERNATE INDEX:                                           DTSBE763
00055 *                                                                 DTSBE763
00056 *        NONE.                                                    DTSBE763
00057 *                                                                 DTSBE763
00058 *                                                                 DTSBE763
00059 *      REFERENCE:                                                 DTSBE763
00060 *                                                                 DTSBE763
00061 *        NONE.                                                    DTSBE763
00062 *                                                                 DTSBE763
00063 *                                                                 DTSBE763
00064 *    RECORDS UPDATED:                                             DTSBE763
00065 *                                                                 DTSBE763
00066 *        NONE.                                                    DTSBE763
00067 *                                                                 DTSBE763
00068 *                                                                 DTSBE763
00069 *    REPORT RECORDS WRITTEN:                                      DTSBE763
00070 *                                                                 DTSBE763
00071 *        R763  JOB SERVICE NEW EMPLOYER LIST.                        CL**7
00072 *                                                                 DTSBE763
00073 *                                                                 DTSBE763
00074 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBE763
00075 *                                                                 DTSBE763
00076 *        NONE.                                                    DTSBE763
00077 *                                                                 DTSBE763
00078 *                                                                 DTSBE763
00079 *    MODULES CALLED:                                              DTSBE763
00080 *                                                                 DTSBE763
00081 *        DTSBU001  DATE CONVERSION/EDIT.                             CL**2
00082 *        DTSBU910  MASTER FILE I/O.                                  CL**2
00083 *        DTSBU946  VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1.      CL**2
00084 *                                                                 DTSBE763
00085 *                                                                 DTSBE763
00086 *    VERMONT REFERENCE:                                           DTSBE763
00087 *                                                                 DTSBE763
00088 *        NONE.                                                    DTSBE763
00089 *                                                                 DTSBE763
00090 *****                                                             DTSBE763
00091                                                                      CL**7
00092  ENVIRONMENT DIVISION.                                            DTSBE763
00093                                                                      CL**7
00094  DATA DIVISION.                                                   DTSBE763
00095      EJECT                                                        DTSBE763
00096  WORKING-STORAGE SECTION.                                         DTSBE763
000965 77  PAN-VALET PICTURE X(24) VALUE '014DTSBE763  09/27/99'.       DTSBE763
00097                                                                      CL**7
00098  01  WRK-AREA.                                                    DTSBE763
00099      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +763.   CL**7
00100                                                                      CL**7
00101      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBE763'.   CL**7
00102                                                                      CL**7
00103      05  ABEND-MSG                   PIC  X(60).                     CL**9
00104                                                                      CL**7
00105      05  WRK-PARM-PERIOD-START-DATE  PIC S9(09)  COMP-3.             CL**9
00106                                                                      CL**7
00107      05  WRK-PARM-PERIOD-END-DATE    PIC S9(09)  COMP-3.             CL**9
00108                                                                      CL**7
00109      05  WRK-MSOL-CTR                PIC S9(02).                     CL**9
00110                                                                      CL*10
00111      05  WRK-EMPL-CNT                PIC S9(08).                     CL*10
00112                                                                      CL**9
00113      05  WRK-R763-REC-WRITTEN-IND    PIC X(01).                      CL**9
00114          88  WRK-R763-REC-WRITTEN                VALUE 'Y'.          CL**9
00115          88  WRK-R763-NO-REC-WRITTEN             VALUE 'N'.          CL**9
00116      EJECT                                                        DTSBE763
00117  01  L001-LINK-AREA.                                              DTSBE763
00118  ++INCLUDE DTSIL001                                                  CL**2
00119      EJECT                                                        DTSBE763
00120  01  L004-LINK-AREA.                                                 CL**9
00121  ++INCLUDE DTSIL004                                                  CL**9
00122      EJECT                                                           CL**9
00123  01  L910-LINK-AREA.                                              DTSBE763
00124  ++INCLUDE DTSIL910                                                  CL**2
00125      EJECT                                                           CL*11
00126  01  MSKL-REC.                                                    DTSBE763
00127  ++INCLUDE DTSIMSKL                                                  CL**2
00128      EJECT                                                           CL*11
00129  01  MSOL-REC.                                                    DTSBE763
00130  ++INCLUDE DTSIMSOL                                                  CL**2
00131      EJECT                                                           CL*11
00132  01  MQTR-REC.                                                       CL*11
00133  ++INCLUDE DTSIMQTR                                                  CL*11
00134      EJECT                                                           CL*11
00135  01  MTAD-REC.                                                       CL*11
00136  ++INCLUDE DTSIMTAD                                                  CL*11
00137      EJECT                                                        DTSBE763
00138  01  R763-REC.                                                       CL**7
00139  ++INCLUDE DTSIR763                                                  CL**7
00140      EJECT                                                        DTSBE763
00141  LINKAGE SECTION.                                                 DTSBE763
00142                                                                      CL**7
00143  01  LECM-LINK-AREA.                                              DTSBE763
00144  ++INCLUDE DTSILECM                                                  CL**2
00145                                                                      CL**7
00146          10  LECM-PARM-AREA REDEFINES LECM-EXTRACT-PARMS.         DTSBE763
00147              15  LECM-PARM-PERIOD-START-DATE PIC  X(06).          DTSBE763
00148              15  FILLER                      PIC  X(01).          DTSBE763
00149              15  LECM-PARM-PERIOD-END-DATE   PIC  X(06).          DTSBE763
00150              15  FILLER                      PIC  X(55).          DTSBE763
00151      EJECT                                                        DTSBE763
00152  01  MPRF-LINK-REC.                                               DTSBE763
00153  ++INCLUDE DTSIMPRF                                                  CL**2
00154      EJECT                                                        DTSBE763
00155 **************************************************************    DTSBE763
00156 *  PROCEDURE DIVISION FOR DTSBE763 STARTS HERE.                      CL**7
00157 **************************************************************    DTSBE763
00158                                                                   DTSBE763
00159  PROCEDURE DIVISION USING LECM-LINK-AREA                          DTSBE763
00160                           MPRF-LINK-REC.                          DTSBE763
00161                                                                      CL**7
00162      MOVE LENGTH OF R763-REC TO R763-LENGTH.                         CL**7
00163      MOVE '763'              TO R763-REC-TYPE.                       CL**7
00164                                                                      CL**7
00165      EVALUATE LECM-CALL-TYPE-IND                                     CL**9
00166        WHEN 'P'                                                      CL**9
00167          PERFORM P0000-PROCESS                                       CL**9
00168             THRU P0000-EXIT                                          CL**9
00169        WHEN 'I'                                                      CL**9
00170          PERFORM I0000-INITIALIZE                                    CL**9
00171             THRU I0000-EXIT                                          CL**9
00172        WHEN 'T'                                                      CL**9
00173          PERFORM T0000-TERMINATE                                     CL**9
00174             THRU T0000-EXIT                                          CL**9
00175        WHEN OTHER                                                    CL**9
00176          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBE763
00177            TO ABEND-MSG                                           DTSBE763
00178          PERFORM S999-ABEND                                          CL**9
00179             THRU S999-EXIT                                           CL**9
00180      END-EVALUATE.                                                   CL**9
00181                                                                      CL**7
00182      GOBACK.                                                      DTSBE763
00183      EJECT                                                        DTSBE763
00184 **************************************************************    DTSBE763
00185 *  THIS PARAGRAPH PERFORMS THE INITIALIZATION PROCESS.            DTSBE763
00186 **************************************************************    DTSBE763
00187                                                                   DTSBE763
00188  I0000-INITIALIZE.                                                DTSBE763
00189                                                                      CL**7
00190      MOVE LECM-TRACE-IND TO L910-TRACE-IND.                       DTSBE763
00191      MOVE WRK-MOD-NAME   TO L910-MOD-NAME.                           CL**9
00192                                                                   DTSBE763
00193      PERFORM I1000-EDIT-AND-DEFAULT-PARMS                            CL**9
00194         THRU I1000-EXIT.                                             CL**9
00195                                                                      CL**7
00196      SET LECM-MST-OPEN-READ-88 TO TRUE.                           DTSBE763
00197      SET LECM-REF-OPEN-READ-88 TO TRUE.                           DTSBE763
00198                                                                      CL**7
00199  I0000-EXIT.                                                      DTSBE763
00200      EXIT.                                                        DTSBE763
00201                                                                      CL**7
00202  I1000-EDIT-AND-DEFAULT-PARMS.                                    DTSBE763
00203      MOVE LECM-LAST-PEN-ASSESSED-YRQ TO L004-QTR-5-9.                CL**9
00204                                                                      CL**9
00205      PERFORM S004-FROM-5                                             CL**9
00206         THRU S004-EXIT.                                              CL**9
00207                                                                      CL**9
00208      PERFORM I1100-PERIOD-START-DATE                                 CL**9
00209         THRU I1100-EXIT.                                             CL**9
00210                                                                   DTSBE763
00211      PERFORM I1200-PERIOD-END-DATE                                   CL**9
00212         THRU I1200-EXIT.                                             CL**9
00213                                                                   DTSBE763
00214  I1000-EXIT.                                                      DTSBE763
00215      EXIT.                                                        DTSBE763
00216                                                                      CL**7
00217  I1100-PERIOD-START-DATE.                                         DTSBE763
00218      IF LECM-PARM-PERIOD-START-DATE = SPACES                      DTSBE763
00219          MOVE L004-QTR-START-DATE TO WRK-PARM-PERIOD-START-DATE      CL**9
00220      ELSE                                                         DTSBE763
00221          MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X    DTSBE763
00222          PERFORM S001-FROM-CAL-6                                     CL**9
00223             THRU S001-EXIT                                           CL**9
00224          IF L001-VALID-DATE                                       DTSBE763
00225              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE763
00226          ELSE                                                     DTSBE763
00227              MOVE 'PERIOD-START-DATE NOT VALID'                   DTSBE763
00228                TO ABEND-MSG                                       DTSBE763
00229              PERFORM S999-ABEND                                      CL**9
00230                 THRU S999-EXIT.                                      CL**9
00231  I1100-EXIT.                                                      DTSBE763
00232      EXIT.                                                        DTSBE763
00233      EJECT                                                        DTSBE763
00234  I1200-PERIOD-END-DATE.                                           DTSBE763
00235      IF LECM-PARM-PERIOD-END-DATE = SPACES                           CL**9
00236          MOVE L004-QTR-END-DATE TO WRK-PARM-PERIOD-END-DATE          CL**9
00237      ELSE                                                            CL**9
00238          MOVE LECM-PARM-PERIOD-END-DATE TO L001-CAL-6-DATE-X         CL**9
00239          PERFORM S001-FROM-CAL-6                                     CL**9
00240             THRU S001-EXIT                                           CL**9
00241          IF L001-VALID-DATE                                          CL**9
00242              MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-END-DATE      CL**9
00243          ELSE                                                        CL**9
00244              MOVE 'PERIOD-END-DATE NOT VALID'                        CL**9
00245                TO ABEND-MSG                                          CL**9
00246              PERFORM S999-ABEND                                      CL**9
00247                 THRU S999-EXIT.                                      CL**9
00248                                                                   DTSBE763
00249      IF WRK-PARM-PERIOD-START-DATE > WRK-PARM-PERIOD-END-DATE     DTSBE763
00250          MOVE 'PERIOD START DATE IS GREATER THAN PERIOD END DATE' DTSBE763
00251            TO ABEND-MSG                                           DTSBE763
00252          PERFORM S999-ABEND                                          CL**9
00253             THRU S999-EXIT.                                          CL**9
00254  I1200-EXIT.                                                      DTSBE763
00255      EXIT.                                                        DTSBE763
00256      EJECT                                                        DTSBE763
00257 **************************************************************    DTSBE763
00258 *   THIS IS THE PROCESS PARAGRAPH FOR DTSBE763 - R & A               CL**7
00259 *   NEW AND INACTIVATED EMPLOYER REPORT.                          DTSBE763
00260 **************************************************************    DTSBE763
00261                                                                   DTSBE763
00262  P0000-PROCESS.                                                   DTSBE763
00263                                                                   DTSBE763
00264      IF MPRF-SIC-PRIV-HOUSEHOLDS-88                                  CL**9
00265      OR MPRF-NAICS-PRIV-HOUSEHOLDS-88                                CL**9
00266          GO TO P0000-EXIT.                                           CL**9
00267                                                                      CL**9
00268      MOVE LOW-VALUES    TO MSOL-KEY-AREA.                            CL**9
00269      MOVE MPRF-EMP-NO   TO MSOL-EMP-NO.                              CL**9
00270      SET MSOL-SOL-88    TO TRUE.                                     CL**9
00271      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                            CL**9
00272                                                                   DTSBE763
00273      PERFORM S910-START-BROWSE                                       CL**9
00274         THRU S910-EXIT.                                              CL**9
00275                                                                   DTSBE763
00276      SET WRK-R763-NO-REC-WRITTEN TO TRUE.                            CL**9
00277      MOVE +0 TO WRK-MSOL-CTR.                                        CL**9
00278                                                                   DTSBE763
00279      PERFORM P1000-SCAN-MSOL                                         CL**9
00280         THRU P1000-EXIT                                              CL**9
00281           UNTIL L910-NO-REC-88                                       CL**9
00282             OR  WRK-R763-REC-WRITTEN.                                CL**9
00283                                                                   DTSBE763
00284  P0000-EXIT.                                                      DTSBE763
00285      EXIT.                                                        DTSBE763
00286      EJECT                                                        DTSBE763
00287 **************************************************************    DTSBE763
00288 *   THIS PARAGRAPH SCANS THE MSOL RECORDS AND WRITES AN R763         CL**7
00289 *   RECORD IF THE EMPLOYER WAS NEWLY REGISTERED WITHIN THE           CL**7
00290 *   PARM PERIOD, REMAINS ACTIVE AS OF THE EXTRACT RUN DATE,          CL**7
00291 *   AND EMPLOYS 40 OR MORE EMPLOYEES.                                CL**7
00292 **************************************************************    DTSBE763
00293                                                                   DTSBE763
00294  P1000-SCAN-MSOL.                                                 DTSBE763
00295      MOVE MSKL-REC TO MSOL-REC.                                      CL**9
00296                                                                   DTSBE763
00297      IF NOT MSOL-INACT-WITHDRAWN-88                                  CL**9
00298          ADD +1 TO WRK-MSOL-CTR                                      CL**9
00299          IF  MSOL-ESTB-DATE NOT < WRK-PARM-PERIOD-START-DATE         CL**9
00300          AND MSOL-ESTB-DATE NOT > WRK-PARM-PERIOD-END-DATE           CL**9
00301              IF MSOL-INACT-ACTIVE-88                                 CL**9
00302                  MOVE 0 TO WRK-EMPL-CNT                              CL*10
00303                  PERFORM P2000-FIND-EMPL-CNT                         CL**9
00304                     THRU P2000-EXIT                                  CL**9
00305                  IF WRK-EMPL-CNT NOT < 40                            CL**9
00306                      SET WRK-R763-REC-WRITTEN TO TRUE                CL**9
00307                      PERFORM P1100-SETUP-R763                        CL**9
00308                         THRU P1100-EXIT                              CL**9
00309                      PERFORM S946-WRITE-R763                         CL**9
00310                         THRU S946-EXIT.                              CL**9
00311                                                                   DTSBE763
00312      PERFORM S910-READ-NEXT                                          CL**9
00313         THRU S910-EXIT.                                              CL**9
00314                                                                   DTSBE763
00315  P1000-EXIT.                                                      DTSBE763
00316      EXIT.                                                        DTSBE763
00317      EJECT                                                        DTSBE763
00318 ***************************************************************   DTSBE763
00319 *   THIS PARAGRAPH SETS UP THE R763 EXTRACT RECORD.                  CL**7
00320 ***************************************************************   DTSBE763
00321                                                                   DTSBE763
00322  P1100-SETUP-R763.                                                   CL**7
00323                                                                   DTSBE763
00324      MOVE WRK-PARM-PERIOD-START-DATE   TO  R763-START-DT.            CL*14
00325      MOVE WRK-PARM-PERIOD-END-DATE     TO  R763-END-DT.              CL*14
00326      MOVE MPRF-EMP-NO                  TO  R763-EMP-NO.              CL*14
00327      IF WRK-MSOL-CTR = 1                                             CL*10
00328          MOVE 'N'                      TO  R763-EMP-STATUS           CL**9
00329      ELSE                                                            CL**9
00330          MOVE 'R'                      TO  R763-EMP-STATUS.          CL**9
00331      MOVE MPRF-PRIMARY-NAME            TO  R763-PRIMARY-NAME.        CL**9
00332      IF MPRF-NAICS-CD-NONCLASSIF-88                                  CL*10
00333          MOVE '00'                     TO  R763-SIC-00               CL*11
00334          MOVE MPRF-SIC-CD              TO  R763-SIC-CD               CL*11
00335      ELSE                                                            CL*10
00336          MOVE MPRF-NAICS-CD            TO  R763-NAICS-CD.            CL*10
00337                                                                      CL*10
00338      MOVE LOW-VALUES                   TO  MTAD-KEY-AREA.            CL**9
00339      MOVE MPRF-EMP-NO                  TO  MTAD-EMP-NO.              CL**9
00340      SET  MTAD-TAD-88                  TO  TRUE.                     CL**9
00341      SET  MTAD-ID-TAX-RECORDS-ADDR-88  TO  TRUE.                     CL**9
00342      MOVE MTAD-KEY-AREA                TO  MSKL-KEY-AREA.            CL**9
00343                                                                   DTSBE763
00344      PERFORM S910-READ                                               CL**9
00345         THRU S910-EXIT.                                              CL**9
00346                                                                   DTSBE763
00347      IF L910-NO-REC-88                                               CL*10
00348          SET  MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE                    CL*10
00349          MOVE MTAD-KEY-AREA               TO  MSKL-KEY-AREA          CL*10
00350          PERFORM S910-READ                                           CL*10
00351             THRU S910-EXIT.                                          CL*10
00352                                                                   DTSBE763
00353      IF L910-NO-REC-88                                               CL*10
00354          MOVE SPACES       TO R763-ADDRESS                           CL*10
00355                               R763-VOICE                             CL*11
00356      ELSE                                                            CL*10
00357          MOVE MSKL-REC     TO MTAD-REC                               CL*13
00358          MOVE MTAD-ADDRESS TO R763-ADDRESS                           CL*10
00359          MOVE MTAD-VOICE-1 TO R763-VOICE.                            CL*11
00360  P1100-EXIT.                                                      DTSBE763
00361       EXIT.                                                       DTSBE763
00362       EJECT                                                       DTSBE763
00363  P2000-FIND-EMPL-CNT.                                                CL*10
00364      MOVE LOW-VALUES  TO MSKL-KEY-AREA.                              CL*10
00365      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                                CL*10
00366      SET  MSKL-QTR-88 TO TRUE.                                       CL*10
00367                                                                      CL*10
00368      PERFORM S910-START-BROWSE                                       CL*10
00369         THRU S910-EXIT.                                              CL*10
00370                                                                      CL*10
00371      IF NOT L910-NO-REC-88                                           CL*10
00372          PERFORM                                                     CL*10
00373            UNTIL L910-NO-REC-88                                      CL*10
00374              MOVE MSKL-REC TO MQTR-REC                               CL*10
00375              IF MQTR-CURR-RCVD-88                                    CL*10
00376                  IF  NOT MQTR-1ST-MTH-NO-ENTRY-88                    CL*10
00377                      MOVE MQTR-1ST-MTH-EMPL-CNT TO WRK-EMPL-CNT      CL*10
00378                  END-IF                                              CL*10
00379                  IF  NOT MQTR-2ND-MTH-NO-ENTRY-88                    CL*10
00380                  AND MQTR-2ND-MTH-EMPL-CNT > WRK-EMPL-CNT            CL*10
00381                      MOVE MQTR-2ND-MTH-EMPL-CNT TO WRK-EMPL-CNT      CL*10
00382                  END-IF                                              CL*10
00383                  IF  NOT MQTR-3RD-MTH-NO-ENTRY-88                    CL*10
00384                  AND MQTR-3RD-MTH-EMPL-CNT > WRK-EMPL-CNT            CL*10
00385                      MOVE MQTR-3RD-MTH-EMPL-CNT TO WRK-EMPL-CNT      CL*10
00386                  END-IF                                              CL*10
00387              END-IF                                                  CL*10
00388              PERFORM S910-READ-NEXT                                  CL*10
00389                 THRU S910-EXIT                                       CL*10
00390          END-PERFORM.                                                CL*10
00391                                                                      CL*11
00392  P2000-EXIT.                                                         CL*11
00393      EXIT.                                                           CL*11
00394      EJECT                                                           CL*11
00395  T0000-TERMINATE.                                                 DTSBE763
00396                                                                      CL**7
00397                                                                      CL**7
00398  T0000-EXIT.                                                      DTSBE763
00399      EXIT.                                                        DTSBE763
00400      EJECT                                                        DTSBE763
00401  S001-FROM-FED-8.                                                 DTSBE763
00402      SET L001-FROM-FED-8 TO TRUE.                                 DTSBE763
00403      GO TO S001-DATE.                                             DTSBE763
00404                                                                      CL**7
00405  S001-FROM-CAL-6.                                                 DTSBE763
00406      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBE763
00407      GO TO S001-DATE.                                             DTSBE763
00408                                                                      CL**7
00409  S001-FROM-ABS-DAY.                                               DTSBE763
00410      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBE763
00411      GO TO S001-DATE.                                             DTSBE763
00412                                                                      CL**7
00413  S001-DATE.                                                       DTSBE763
00414      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**2
00415  S001-EXIT.                                                       DTSBE763
00416      EXIT.                                                        DTSBE763
00417                                                                      CL**7
00418  S004-FROM-5.                                                        CL**9
00419      SET L004-FROM-5 TO TRUE.                                        CL**9
00420      GO TO S004-YRQ.                                                 CL**9
00421                                                                      CL**9
00422  S004-FROM-ABS.                                                      CL**9
00423      SET L004-FROM-ABS TO TRUE.                                      CL**9
00424      GO TO S004-YRQ.                                                 CL**9
00425                                                                      CL**9
00426  S004-FROM-DATE.                                                     CL**9
00427      SET L004-FROM-DATE TO TRUE.                                     CL**9
00428      GO TO S004-YRQ.                                                 CL**9
00429                                                                      CL**9
00430  S004-YRQ.                                                           CL*12
00431      CALL 'DTSBU004' USING L004-LINK-AREA.                           CL**9
00432  S004-EXIT.                                                          CL*11
00433      EXIT.                                                           CL**9
00434                                                                      CL**9
00435  S910-READ.                                                       DTSBE763
00436      SET L910-READ-88 TO TRUE.                                    DTSBE763
00437      GO TO S910-MSTR-IO.                                          DTSBE763
00438                                                                      CL**7
00439  S910-START-BROWSE.                                               DTSBE763
00440      SET L910-START-BROWSE-88 TO TRUE.                            DTSBE763
00441      GO TO S910-MSTR-IO.                                          DTSBE763
00442                                                                      CL**7
00443  S910-READ-NEXT.                                                  DTSBE763
00444      SET L910-READ-NEXT-88 TO TRUE.                               DTSBE763
00445      GO TO S910-MSTR-IO.                                          DTSBE763
00446                                                                      CL**7
00447  S910-COUNT.                                                      DTSBE763
00448      SET L910-COUNT-88 TO TRUE.                                   DTSBE763
00449      GO TO S910-MSTR-IO.                                          DTSBE763
00450                                                                      CL**7
00451  S910-MSTR-IO.                                                    DTSBE763
00452      CALL 'DTSBU910' USING L910-LINK-AREA                            CL**2
00453                            MSKL-REC.                              DTSBE763
00454  S910-EXIT.                                                       DTSBE763
00455      EXIT.                                                        DTSBE763
00456                                                                      CL**7
00457  S946-WRITE-R763.                                                    CL*10
00458      CALL 'DTSBU946' USING R763-REC.                                 CL*10
00459      GO TO S946-EXIT.                                             DTSBE763
00460                                                                      CL**7
00461  S946-EXIT.                                                       DTSBE763
00462      EXIT.                                                        DTSBE763
00463                                                                      CL**7
00464  S999-ABEND.                                                      DTSBE763
00465      DISPLAY '*** DTSBE763 ABENDING.  '                              CL*10
00466              ABEND-MSG.                                           DTSBE763
00467                                                                      CL**7
00468      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00469  S999-EXIT.                                                       DTSBE763
00470      EXIT.                                                        DTSBE763
