00001  IDENTIFICATION DIVISION.                                         07/01/99
00002  PROGRAM-ID.             DTSBR720.                                DTSBR720
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION     LV011
00004                          MODIFIED BY TRW/BDM OCT. 1998.              CL**2
00005  DATE-WRITTEN.           DECEMBER 1994.                           DTSBR720
00006  DATE-COMPILED.                                                   DTSBR720
00007                                                                      CL**5
00008 *****                                                             DTSBR720
00009 *                                                                 DTSBR720
00010 *    CALLING SEQUENCE:  DTSBD400 CALLS                               CL**3
00011 *                       DTSBE720 WHICH UPDATES DTSIR720              CL**3
00012 *                       DTSBR720 READS DTSIR720 RECORDS.             CL**3
00013 *                                                                    CL**3
00014 *    FUNCTION:  RQC DEBITS/BILLINGS UNIVERSE RECORD BUILD.        DTSBR720
00015 *                                                                 DTSBR720
00016 *                                                                 DTSBR720
00017 *    MODIFICATION HISTORY:                                        DTSBR720
00018 *                                                                 DTSBR720
00019 * 12-11-94 INITIAL DEVELOPMENT                                    DTSBR720
00020 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR720
00021 *                                                                 DTSBR720
00022 * 04-07-95 RECOMPILED FOR R991-UNIT-DSCR PER CHANGE REQUEST 064   DTSBR720
00023 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR720
00024 *                                                                 DTSBR720
00025 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR720
00026 *          XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  DTSBR720
00027 *          REFERENCE RFP #****            AUTHOR OF CHANGE - XXX  DTSBR720
00028 *                                                                 DTSBR720
00029 *                                                                 DTSBR720
00030 *    DESCRIPTION:                                                 DTSBR720
00031 *                                                                 DTSBR720
00032 *        THIS MODULE CREATES A FILE(S) OF RQC DEBITS/BILLINGS     DTSBR720
00033 *        TRANSACTION RECORDS FOR EXPORT TO THE DEPARTMENTAL RQC   DTSBR720
00034 *        SYSTEM.                                                  DTSBR720
00035 *                                                                 DTSBR720
00036 *        THIS IS AN "AT LEAST ONCE" MODULE.                       DTSBR720
00037 *                                                                 DTSBR720
00038 *                                                                 DTSBR720
00039 *    RECORDS READ:                                                DTSBR720
00040 *                                                                 DTSBR720
00041 *        NONE.                                                    DTSBR720
00042 *                                                                 DTSBR720
00043 *                                                                 DTSBR720
00044 *    PRINTED OUTPUTS:                                             DTSBR720
00045 *                                                                 DTSBR720
00046 *        NONE.                                                    DTSBR720
00047 *                                                                 DTSBR720
00048 *                                                                 DTSBR720
00049 *    RECORDS WRITTEN:                                             DTSBR720
00050 *                                                                 DTSBR720
00051 *        720R1  RQC DEBITS/BILLINGS CNTRB UNIVERSE RECORDS.       DTSBR720
00052 *        720R2  RQC DEBITS/BILLINGS REIMB UNIVERSE RECORDS.       DTSBR720
00053 *                                                                 DTSBR720
00054 *                                                                 DTSBR720
00055 *    MODULES CALLED:                                              DTSBR720
00056 *                                                                 DTSBR720
00057 *        GETSER   DATASET INFORMATION MODULE                      DTSBR720
00058 *        DTSBR991 EXPORT CONTROL REPORT MODULE                       CL**4
00059 *                                                                 DTSBR720
00060 *                                                                 DTSBR720
00061 *****                                                             DTSBR720
00062      EJECT                                                        DTSBR720
00063  ENVIRONMENT DIVISION.                                            DTSBR720
00064                                                                      CL**5
00065  INPUT-OUTPUT SECTION.                                            DTSBR720
00066                                                                      CL**5
00067  FILE-CONTROL.                                                    DTSBR720
00068      SELECT EXPORT-FILE1 ASSIGN TO RPT720R1                       DTSBR720
00069          FILE STATUS IS WS-FILE1-STATUS.                          DTSBR720
00070      SELECT EXPORT-FILE2 ASSIGN TO RPT720R2                       DTSBR720
00071          FILE STATUS IS WS-FILE2-STATUS.                          DTSBR720
00072                                                                      CL**5
00073  DATA DIVISION.                                                   DTSBR720
00074                                                                      CL**5
00075  FILE SECTION.                                                    DTSBR720
00076                                                                      CL**5
00077  FD  EXPORT-FILE1                                                 DTSBR720
00078      RECORDING MODE IS F                                          DTSBR720
00079      BLOCK CONTAINS 0 RECORDS.                                    DTSBR720
00080  01  EXPORT-REC1                    PIC  X(82).                   DTSBR720
00081                                                                      CL**5
00082  FD  EXPORT-FILE2                                                 DTSBR720
00083      RECORDING MODE IS F                                          DTSBR720
00084      BLOCK CONTAINS 0 RECORDS.                                    DTSBR720
00085  01  EXPORT-REC2                    PIC  X(82).                   DTSBR720
00086      EJECT                                                        DTSBR720
00087  WORKING-STORAGE SECTION.                                         DTSBR720
000875 77  PAN-VALET PICTURE X(24) VALUE '011DTSBR720  07/01/99'.       DTSBR720
00088                                                                      CL**5
00089  01  WRK-AREA.                                                    DTSBR720
00090      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +720.DTSBR720
00091      05  ABEND-MSG                   PIC  X(60).                     CL**8
00092      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR720
00093      05  WS-FILE1-STATUS             PIC  X(02).                  DTSBR720
00094          88  FILE1-OK-88                         VALUE '00'.      DTSBR720
00095      05  WS-FILE2-STATUS             PIC  X(02).                  DTSBR720
00096          88  FILE2-OK-88                         VALUE '00'.      DTSBR720
00097      05  WS-REIMB-RECORD-COUNT       PIC S9(07)  COMP-3.          DTSBR720
00098      05  WS-CNTRB-RECORD-COUNT       PIC S9(07)  COMP-3.          DTSBR720
00099                                                                      CL**5
00100  01  WS-EXPORT-REC.                                               DTSBR720
00101      05  WS-SEQ-NUMBER               PIC  9(08).                  DTSBR720
00102      05  FILLER                      PIC  X(05)  VALUE 'CS042'.   DTSBR720
00103      05  WS-TRAN-TYPE                PIC  X(01).                  DTSBR720
00104      05  FILLER                      PIC  X(07)  VALUE '1000000'. DTSBR720
00105      05  WS-EMP-NO                   PIC  9(06).                  DTSBR720
00106      05  WS-RUN-DATE                 PIC  9(08).                  DTSBR720
00107      05  WS-TAX-DUE                  PIC  9(11).                  DTSBR720
00108      05  WS-TAX-PAID                 PIC  9(11).                  DTSBR720
00109      05  FILLER                      PIC  X(25)  VALUE SPACES.    DTSBR720
00110      EJECT                                                        DTSBR720
00111  01  R991-REC.                                                    DTSBR720
00112  ++INCLUDE DTSIR991                                                  CL**4
00113      EJECT                                                        DTSBR720
00114  LINKAGE SECTION.                                                 DTSBR720
00115                                                                      CL**5
00116  01  LRCM-LINK-AREA.                                              DTSBR720
00117  ++INCLUDE DTSILRCM                                                  CL**4
00118      EJECT                                                        DTSBR720
00119  01  R720-REC.                                                    DTSBR720
00120  ++INCLUDE DTSIR720                                                  CL**4
00121      EJECT                                                        DTSBR720
00122  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR720
00123                           R720-REC.                               DTSBR720
00124                                                                      CL**5
00125      IF FIRST-TIME-IND = 'Y'                                      DTSBR720
00126          PERFORM I1000-INITIATE                                      CL**5
00127             THRU I1000-EXIT                                          CL**5
00128          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR720
00129                                                                      CL**5
00130      IF LRCM-EOR-88                                               DTSBR720
00131          PERFORM T1000-TERMINATE                                     CL**5
00132             THRU T1000-EXIT                                          CL**5
00133      ELSE                                                         DTSBR720
00134          PERFORM P1000-PROCESS                                       CL**5
00135             THRU P1000-EXIT.                                         CL**5
00136                                                                      CL**5
00137      GOBACK.                                                      DTSBR720
00138      EJECT                                                        DTSBR720
00139  I1000-INITIATE.                                                  DTSBR720
00140                                                                      CL**5
00141      OPEN OUTPUT EXPORT-FILE1 EXPORT-FILE2.                       DTSBR720
00142                                                                      CL**5
00143      MOVE '720'                  TO R991-MOD.                        CL**5
00144      MOVE 'TPS DESK'             TO R991-ROUTE1.                     CL*10
00145      MOVE 'ENFORCEMENT UNIT    ' TO R991-ROUTE2.                     CL*10
00146      MOVE +0                     TO WS-REIMB-RECORD-COUNT            CL**5
00147                                     WS-CNTRB-RECORD-COUNT.           CL**5
00148                                                                      CL**5
00149  I1000-EXIT.                                                      DTSBR720
00150      EXIT.                                                        DTSBR720
00151      EJECT                                                        DTSBR720
00152  P1000-PROCESS.                                                   DTSBR720
00153                                                                      CL**5
00154      MOVE R720-EMP-NO     TO WS-EMP-NO.                              CL**5
00155      MOVE R720-TRANS-TYPE TO WS-TRAN-TYPE.                        DTSBR720
00156      MOVE R720-RUN-DATE   TO WS-RUN-DATE.                            CL**5
00157      MOVE R720-TAX-DUE    TO WS-TAX-DUE.                             CL**5
00158      MOVE R720-TAX-PAID   TO WS-TAX-PAID.                            CL**5
00159                                                                      CL**5
00160      IF R720-TRANS-TYPE-CNTRB-88                                  DTSBR720
00161          ADD +1                      TO  WS-CNTRB-RECORD-COUNT       CL**5
00162          MOVE WS-CNTRB-RECORD-COUNT  TO  WS-SEQ-NUMBER               CL**5
00163          WRITE EXPORT-REC1          FROM WS-EXPORT-REC               CL**5
00164          IF FILE1-OK-88                                           DTSBR720
00165              NEXT SENTENCE                                        DTSBR720
00166          ELSE                                                     DTSBR720
00167              PERFORM S999-ABEND                                      CL**5
00168                 THRU S999-EXIT                                       CL**5
00169      ELSE                                                         DTSBR720
00170      IF R720-TRANS-TYPE-REIMB-88                                     CL**8
00171          ADD +1                      TO  WS-REIMB-RECORD-COUNT       CL**5
00172          MOVE WS-REIMB-RECORD-COUNT  TO  WS-SEQ-NUMBER               CL**5
00173          WRITE EXPORT-REC2          FROM WS-EXPORT-REC               CL**5
00174          IF FILE2-OK-88                                           DTSBR720
00175              NEXT SENTENCE                                        DTSBR720
00176          ELSE                                                     DTSBR720
00177              PERFORM S999-ABEND                                      CL**5
00178                 THRU S999-EXIT                                       CL**8
00179      ELSE                                                            CL**8
00180           MOVE 'INVALID TRANS-TYPE' TO ABEND-MSG                     CL*11
00181           PERFORM S999-ABEND                                         CL**8
00182           THRU S999-EXIT.                                            CL**9
00183                                                                      CL**8
00184  P1000-EXIT.                                                      DTSBR720
00185      EXIT.                                                        DTSBR720
00186      EJECT                                                        DTSBR720
00187  T1000-TERMINATE.                                                 DTSBR720
00188                                                                      CL**5
00189      MOVE 'DEBITS/BILLINGS UNIVERSE RECORDS - CONTRIBUTORY'       DTSBR720
00190                                      TO R991-DATA-TYPE.              CL**5
00191      MOVE 'RECORDS'                  TO R991-UNIT-DSCR.              CL**5
00192      MOVE WS-CNTRB-RECORD-COUNT      TO R991-UNIT-COUNT.             CL**5
00193                                                                      CL**5
00194      PERFORM R991-EXPORT-CONTROL-REPORT                              CL**5
00195         THRU R991-EXIT.                                              CL**5
00196                                                                      CL**5
00197      CLOSE EXPORT-FILE1.                                          DTSBR720
00198                                                                      CL**5
00199 *    IF WS-REIMB-RECORD-COUNT = +0                                   CL**7
00200 *        MOVE SPACES TO R991-DATASET-NAME                            CL**7
00201 *    ELSE                                                            CL**7
00202 *        CALL 'GETSER' USING EXPORT-FILE2                            CL**7
00203 *                            WS-GETSER-VOL-SER                       CL**7
00204 *                            WS-GETSER-DATASET-NAME                  CL**7
00205 *                            WS-GETSER-VOLUME-COUNT                  CL**7
00206 *                            WS-GETSER-DD-NAME                       CL**7
00207 *                            WS-GETSER-STEP-NAME                     CL**7
00208 *        MOVE WS-GETSER-DATASET-NAME TO R991-DATASET-NAME.           CL**7
00209                                                                      CL**5
00210      MOVE 'DEBITS/BILLINGS UNIVERSE RECORDS - REIMBURSABLE'       DTSBR720
00211                                      TO R991-DATA-TYPE.              CL**5
00212      MOVE 'RECORDS'                  TO R991-UNIT-DSCR.              CL**5
00213      MOVE WS-REIMB-RECORD-COUNT      TO R991-UNIT-COUNT.             CL**5
00214                                                                      CL**5
00215      PERFORM R991-EXPORT-CONTROL-REPORT                              CL**5
00216         THRU R991-EXIT.                                              CL**5
00217                                                                      CL**5
00218      CLOSE EXPORT-FILE2.                                          DTSBR720
00219                                                                      CL**5
00220  T1000-EXIT.                                                      DTSBR720
00221      EXIT.                                                        DTSBR720
00222      EJECT                                                        DTSBR720
00223  R991-EXPORT-CONTROL-REPORT.                                      DTSBR720
00224                                                                      CL**5
00225      CALL 'DTSBR991' USING LRCM-LINK-AREA                            CL**4
00226                            R991-REC.                              DTSBR720
00227                                                                      CL**5
00228  R991-EXIT.                                                       DTSBR720
00229      EXIT.                                                        DTSBR720
00230                                                                      CL**5
00231  S999-ABEND.                                                      DTSBR720
00232                                                                      CL**5
00233      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**4
00234                                                                      CL**5
00235  S999-EXIT.                                                       DTSBR720
00236      EXIT.                                                        DTSBR720
