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