00001 IDENTIFICATION DIVISION. 04/17/13 00002 PROGRAM-ID. DTSBX715. DTSBX715 00003 AUTHOR. NGC. LV001 00004 DATE-WRITTEN. FEBRUARY 2009. DTSBX715 00005 DATE-COMPILED. DTSBX715 00006 SKIP3 DTSBX715 00007 ***** DTSBX715 00008 * DTSBX715 00009 * DTSBX715 00010 * FUNCTION: TPS STATUS DETERMINATION UNIVERSE RECORDS EXTRACT.DTSBX715 00011 * CALLED FROM DATA VALIDATION/ETA-581 PROCESS DTSBX715 00012 * DTSBX715 00013 * MODIFICATION LOG: DTSBX715 00014 * DTSBX715 00015 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX715 00016 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX715 00017 * WORK ORDER: PROGRAMMER: XXX DTSBX715 00018 * DTSBX715 00019 * DTSBX715 00020 * DESCRIPTION: DTSBX715 00021 * DTSBX715 00022 * DTSBX715 00023 * INITIATION: DTSBX715 00024 * DTSBX715 00025 * DTSBX715 00026 * EDIT AND DEFAULT PARAMETERS. DTSBX715 00027 * DTSBX715 00028 * DTSBX715 00029 * PROCESSING: DTSBX715 00030 * DTSBX715 00031 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (715R1). DTSBX715 00032 * DTSBX715 00033 * DTSBX715 00034 * TERMINATION: DTSBX715 00035 * DTSBX715 00036 * NONE. DTSBX715 00037 * DTSBX715 00038 * DTSBX715 00039 * RECORDS READ: DTSBX715 00040 * DTSBX715 00041 * MASTER: DTSBX715 00042 * DTSBX715 00043 * MHDR DTSBX715 00044 * MERD DTSBX715 00045 * DTSBX715 00046 * DTSBX715 00047 * ALTERNATE INDEX: DTSBX715 00048 * DTSBX715 00049 * NONE. DTSBX715 00050 * DTSBX715 00051 * DTSBX715 00052 * REFERENCE: DTSBX715 00053 * DTSBX715 00054 * NONE. DTSBX715 00055 * DTSBX715 00056 * DTSBX715 00057 * RECORDS UPDATED: DTSBX715 00058 * DTSBX715 00059 * NONE. DTSBX715 00060 * DTSBX715 00061 * DTSBX715 00062 * REPORT RECORDS WRITTEN: DTSBX715 00063 * DTSBX715 00064 * R715 TPS STATUS DETERMINATION UNIVERSE RECORDS EXTRACT. DTSBX715 00065 * DTSBX715 00066 * DTSBX715 00067 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX715 00068 * DTSBX715 00069 * NONE. DTSBX715 00070 * DTSBX715 00071 * DTSBX715 00072 * MODULES CALLED: DTSBX715 00073 * DTSBX715 00074 * DTSBU001 DATE EDIT/CONVERSION. DTSBX715 00075 * DTSBU910 MASTER FILE I/O. DTSBX715 00076 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBX715 00077 * DTSBX715 00078 * DTSBX715 00079 * VERMONT REFERENCE: DTSBX715 00080 * DTSBX715 00081 * NONE. DTSBX715 00082 * DTSBX715 00083 ***** DTSBX715 00084 SKIP3 DTSBX715 00085 ENVIRONMENT DIVISION. DTSBX715 00086 INPUT-OUTPUT SECTION. DTSBX715 00087 FILE-CONTROL. DTSBX715 00088 SELECT TPS-STATUS-FILE ASSIGN TO TPSSTAT DTSBX715 00089 FILE STATUS IS TPS-STAT-STATUS. DTSBX715 00090 DTSBX715 00091 DATA DIVISION. DTSBX715 00092 FILE SECTION. DTSBX715 00093 FD TPS-STATUS-FILE DTSBX715 00094 RECORDING MODE IS F DTSBX715 00095 LABEL RECORDS ARE STANDARD DTSBX715 00096 BLOCK CONTAINS 0 CHARACTERS. DTSBX715 00097 DTSBX715 00098 01 TPS-STATUS-REC PIC X(56). DTSBX715 00099 DTSBX715 00100 DTSBX715 00101 WORKING-STORAGE SECTION. DTSBX715 001015 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX715 04/17/13'. DTSBX715 00102 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX715 04/15/13'. DTSBX715 00103 77 PAN-VALET PICTURE X(24) VALUE '033DTSBX715 04/03/09'. DTSBX715 00104 SKIP3 DTSBX715 00105 01 WRK-AREA. DTSBX715 00106 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +715.DTSBX715 00107 DTSBX715 00108 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX715'.DTSBX715 00109 05 WRK-TRACE-IND PIC X(01) VALUE 'N'. DTSBX715 00110 DTSBX715 00111 05 ABEND-MSG PIC X(60). DTSBX715 00112 DTSBX715 00113 05 TPS-STAT-STATUS PIC X(02). DTSBX715 00114 88 TPS-STAT-STATUS-OK-88 VALUE '00'. DTSBX715 00115 88 TPS-STAT-STATUS-EOF-88 VALUE '10'. DTSBX715 00116 DTSBX715 00117 05 WRK-ERROR-IND PIC X(01). DTSBX715 00118 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX715 00119 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX715 00120 DTSBX715 00121 05 WRK-NEW-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX715 00122 05 WRK-INACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX715 00123 05 WRK-SUCC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX715 00124 DTSBX715 00125 01 WRK-STATUS-REC. DTSBX715 00126 ++INCLUDE DTSIM715 DTSBX715 00127 DTSBX715 00128 01 L001-LINK-AREA. DTSBX715 00129 ++INCLUDE DTSIL001 DTSBX715 00130 EJECT DTSBX715 00131 01 L910-LINK-AREA. DTSBX715 00132 ++INCLUDE DTSIL910 DTSBX715 00133 SKIP3 DTSBX715 00134 01 MSKL-REC. DTSBX715 00135 ++INCLUDE DTSIMSKL DTSBX715 00136 SKIP3 DTSBX715 00137 01 MHDR-REC. DTSBX715 00138 ++INCLUDE DTSIMHDR DTSBX715 00139 SKIP3 DTSBX715 00140 01 MPRF-REC. DTSBX715 00141 ++INCLUDE DTSIMPRF DTSBX715 00142 SKIP3 DTSBX715 00143 01 R715-REC. DTSBX715 00144 ++INCLUDE DTSIR715 DTSBX715 00145 EJECT DTSBX715 00146 DTSBX715 00147 PROCEDURE DIVISION. DTSBX715 00148 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DTSBX715 00149 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX715 00150 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX715 00151 DTSBX715 00152 GOBACK. DTSBX715 00153 DTSBX715 00154 I0000-INITIALIZE. DTSBX715 00155 MOVE LENGTH OF R715-REC TO R715-LENGTH. DTSBX715 00156 MOVE '715' TO R715-REC-TYPE. DTSBX715 00157 MOVE WRK-TRACE-IND TO L910-TRACE-IND. DTSBX715 00158 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBX715 00159 DTSBX715 00160 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX715 00161 DTSBX715 00162 I0000-EXIT. DTSBX715 00163 EXIT. DTSBX715 00164 DTSBX715 00165 I2000-OPEN-FILES. DTSBX715 00166 OPEN INPUT TPS-STATUS-FILE. DTSBX715 00167 IF NOT TPS-STAT-STATUS-OK-88 DTSBX715 00168 DISPLAY 'CANNOT OPEN TPS STATUS FILE ' DTSBX715 00169 TPS-STAT-STATUS DTSBX715 00170 PERFORM S999-ABEND THRU S999-EXIT DTSBX715 00171 ELSE DTSBX715 00172 READ TPS-STATUS-FILE INTO WRK-STATUS-REC DTSBX715 00173 END-IF. DTSBX715 00174 DTSBX715 00175 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX715 00176 DTSBX715 00177 I2000-EXIT. DTSBX715 00178 EXIT. DTSBX715 00179 DTSBX715 00180 P0000-PROCESS. DTSBX715 00181 PERFORM UNTIL TPS-STAT-STATUS-EOF-88 DTSBX715 00182 PERFORM P0100-FIND-MPRF THRU P0100-EXIT DTSBX715 00183 IF WRK-ERROR-NO-88 DTSBX715 00184 PERFORM P1000-PROCESS-STATUS THRU P1000-EXIT DTSBX715 00185 END-IF DTSBX715 00186 READ TPS-STATUS-FILE INTO WRK-STATUS-REC DTSBX715 00187 END-PERFORM. DTSBX715 00188 DTSBX715 00189 P0000-EXIT. DTSBX715 00190 EXIT. DTSBX715 00191 DTSBX715 00192 P0100-FIND-MPRF. DTSBX715 00193 SET WRK-ERROR-NO-88 TO TRUE. DTSBX715 00194 DTSBX715 00195 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBX715 00196 MOVE M715-EMP-NO TO MSKL-EMP-NO. DTSBX715 00197 SET MSKL-PRF-88 TO TRUE. DTSBX715 00198 DTSBX715 00199 PERFORM S910-READ THRU S910-EXIT. DTSBX715 00200 IF L910-OK-88 DTSBX715 00201 MOVE MSKL-REC TO MPRF-REC DTSBX715 00202 ELSE DTSBX715 00203 DISPLAY 'BX715 CANNOT FIND MPRF ' M715-EMP-NO DTSBX715 00204 SET WRK-ERROR-YES-88 TO TRUE DTSBX715 00205 END-IF. DTSBX715 00206 DTSBX715 00207 P0100-EXIT. DTSBX715 00208 EXIT. DTSBX715 00209 DTSBX715 00210 P1000-PROCESS-STATUS. DTSBX715 00211 EVALUATE TRUE DTSBX715 00212 WHEN M715-DETERM-NEW-88 DTSBX715 00213 PERFORM P1100-NEW THRU P1100-EXIT DTSBX715 00214 DTSBX715 00215 WHEN M715-DETERM-INACT-88 DTSBX715 00216 PERFORM P1200-INACT THRU P1200-EXIT DTSBX715 00217 DTSBX715 00218 WHEN M715-DETERM-SUCC-88 DTSBX715 00219 PERFORM P1300-SUCC THRU P1300-EXIT DTSBX715 00220 DTSBX715 00221 END-EVALUATE. DTSBX715 00222 DTSBX715 00223 P1000-EXIT. DTSBX715 00224 EXIT. DTSBX715 00225 DTSBX715 00226 P1100-NEW. DTSBX715 00227 MOVE M715-EMP-NO TO R715-EMP-NO. DTSBX715 00228 MOVE M715-DETERM-TYPE TO R715-TRAN-TYPE. DTSBX715 00229 MOVE M715-PROCESS-DT TO R715-ENTRY-DATE. DTSBX715 00230 MOVE M715-EFF-DT TO R715-STATUS-EFF-DATE. DTSBX715 00231 MOVE MPRF-PRIMARY-NAME TO R715-PRIMARY-NAME. DTSBX715 00232 DTSBX715 00233 PERFORM S946-WRITE-R715 THRU S946-EXIT. DTSBX715 00234 DTSBX715 00235 ADD +1 TO WRK-NEW-CNT. DTSBX715 00236 DTSBX715 00237 P1100-EXIT. DTSBX715 00238 EXIT. DTSBX715 00239 DTSBX715 00240 P1200-INACT. DTSBX715 00241 MOVE M715-EMP-NO TO R715-EMP-NO. DTSBX715 00242 MOVE M715-DETERM-TYPE TO R715-TRAN-TYPE. DTSBX715 00243 MOVE M715-PROCESS-DT TO R715-ENTRY-DATE. DTSBX715 00244 MOVE M715-EFF-DT TO R715-STATUS-EFF-DATE. DTSBX715 00245 MOVE MPRF-PRIMARY-NAME TO R715-PRIMARY-NAME. DTSBX715 00246 DTSBX715 00247 PERFORM S946-WRITE-R715 THRU S946-EXIT. DTSBX715 00248 DTSBX715 00249 ADD +1 TO WRK-INACT-CNT. DTSBX715 00250 DTSBX715 00251 P1200-EXIT. DTSBX715 00252 EXIT. DTSBX715 00253 DTSBX715 00254 P1300-SUCC. DTSBX715 00255 MOVE M715-EMP-NO TO R715-EMP-NO. DTSBX715 00256 MOVE M715-DETERM-TYPE TO R715-TRAN-TYPE. DTSBX715 00257 MOVE M715-PROCESS-DT TO R715-ENTRY-DATE. DTSBX715 00258 MOVE M715-EFF-DT TO R715-STATUS-EFF-DATE. DTSBX715 00259 MOVE MPRF-PRIMARY-NAME TO R715-PRIMARY-NAME. DTSBX715 00260 DTSBX715 00261 PERFORM S946-WRITE-R715 THRU S946-EXIT. DTSBX715 00262 DTSBX715 00263 ADD +1 TO WRK-SUCC-CNT. DTSBX715 00264 DTSBX715 00265 P1300-EXIT. DTSBX715 00266 EXIT. DTSBX715 00267 DTSBX715 00268 T0000-TERMINATE. DTSBX715 00269 CLOSE TPS-STATUS-FILE. DTSBX715 00270 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX715 00271 DTSBX715 00272 DISPLAY 'NEW ' WRK-NEW-CNT. DTSBX715 00273 DISPLAY 'INACT ' WRK-INACT-CNT. DTSBX715 00274 DISPLAY 'SUCC ' WRK-SUCC-CNT. DTSBX715 00275 T0000-EXIT. DTSBX715 00276 EXIT. DTSBX715 00277 EJECT DTSBX715 00278 S001-FROM-FED-8. DTSBX715 00279 SET L001-FROM-FED-8 TO TRUE. DTSBX715 00280 GO TO S001-DATE. DTSBX715 00281 SKIP1 DTSBX715 00282 S001-FROM-ABS-DAY. DTSBX715 00283 SET L001-FROM-ABS-DAY TO TRUE. DTSBX715 00284 GO TO S001-DATE. DTSBX715 00285 SKIP1 DTSBX715 00286 S001-FROM-CAL-6. DTSBX715 00287 SET L001-FROM-CAL-6 TO TRUE. DTSBX715 00288 GO TO S001-DATE. DTSBX715 00289 SKIP1 DTSBX715 00290 S001-DATE. DTSBX715 00291 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX715 00292 S001-EXIT. DTSBX715 00293 EXIT. DTSBX715 00294 SKIP3 DTSBX715 00295 S910-OPEN-READ. DTSBX715 00296 SET L910-OPEN-READ-88 TO TRUE. DTSBX715 00297 GO TO S910-MSTR-IO. DTSBX715 00298 DTSBX715 00299 S910-READ. DTSBX715 00300 SET L910-READ-88 TO TRUE. DTSBX715 00301 GO TO S910-MSTR-IO. DTSBX715 00302 DTSBX715 00303 S910-START-BROWSE. DTSBX715 00304 SET L910-START-BROWSE-88 TO TRUE. DTSBX715 00305 GO TO S910-MSTR-IO. DTSBX715 00306 DTSBX715 00307 S910-READ-NEXT. DTSBX715 00308 SET L910-READ-NEXT-88 TO TRUE. DTSBX715 00309 GO TO S910-MSTR-IO. DTSBX715 00310 DTSBX715 00311 S910-COUNT. DTSBX715 00312 SET L910-COUNT-88 TO TRUE. DTSBX715 00313 GO TO S910-MSTR-IO. DTSBX715 00314 DTSBX715 00315 S910-CLOSE. DTSBX715 00316 SET L910-CLOSE-88 TO TRUE. DTSBX715 00317 GO TO S910-MSTR-IO. DTSBX715 00318 DTSBX715 00319 S910-MSTR-IO. DTSBX715 00320 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX715 00321 MSKL-REC. DTSBX715 00322 S910-EXIT. DTSBX715 00323 EXIT. DTSBX715 00324 SKIP3 DTSBX715 00325 S946-WRITE-R715. DTSBX715 00326 CALL 'DTSBU946' USING R715-REC. DTSBX715 00327 GO TO S946-EXIT. DTSBX715 00328 SKIP1 DTSBX715 00329 S946-EXIT. DTSBX715 00330 EXIT. DTSBX715 00331 SKIP3 DTSBX715 00332 S999-ABEND. DTSBX715 00333 DISPLAY '*** DTSBE715 ABENDING. ' DTSBX715 00334 ABEND-MSG. DTSBX715 00335 SKIP1 DTSBX715 00336 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX715 00337 S999-EXIT. DTSBX715 00338 EXIT. DTSBX715