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