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