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