00001 IDENTIFICATION DIVISION. 12/18/08 00002 PROGRAM-ID. DTSBE718. DTSBE718 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV016 00004 MODIFIED BY TRW/BDM OCT. 1998. DTSBE718 00005 DATE-WRITTEN. SEPTEMBER 1994. DTSBE718 00006 DATE-COMPILED. DTSBE718 00007 SKIP3 DTSBE718 00008 ***** DTSBE718 00009 * DTSBE718 00010 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE718 00011 * DTSBE718 WHICH UPDATES DTSIR718 DTSBE718 00012 * DTSBR718 READS DTSIR718 RECORDS. DTSBE718 00013 * DTSBE718 00014 * FUNCTION: RQC FIELD AUDIT UNIVERSE RECORDS EXTRACT. DTSBE718 00015 * DTSBE718 00016 * DTSBE718 00017 * MODIFICATION LOG: DTSBE718 00018 * DTSBE718 00019 * 12/18/2008 REMOVED TEST AT THE TOP OF P0000 TO BYPASS DTSBE718 00020 * THE EMPLOYER IS MPRF-MFAS-NO88 IS TRUE. DTSBE718 00021 * THIS TESTS WORKS ONLY IF THERE IS A CURRENTLY DTSBE718 00022 * ACTIVE FIELD ASSIGNMENT. DTSBE718 00023 * WORK ORDER: PROGRAMMER: GD DTSBE718 00024 * DTSBE718 00025 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE718 00026 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE718 00027 * WORK ORDER: PROGRAMMER: XXX DTSBE718 00028 * DTSBE718 00029 * DTSBE718 00030 * DESCRIPTION: DTSBE718 00031 * DTSBE718 00032 * DTSBE718 00033 * INITIATION: DTSBE718 00034 * DTSBE718 00035 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE718 00036 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE718 00037 * DTSBE718 00038 * EDIT AND DEFAULT PARAMETERS. DTSBE718 00039 * DTSBE718 00040 * DTSBE718 00041 * PROCESSING: DTSBE718 00042 * DTSBE718 00043 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (718R1). DTSBE718 00044 * DTSBE718 00045 * DTSBE718 00046 * TERMINATION: DTSBE718 00047 * DTSBE718 00048 * NONE. DTSBE718 00049 * DTSBE718 00050 * DTSBE718 00051 * RECORDS READ: DTSBE718 00052 * DTSBE718 00053 * MASTER: DTSBE718 00054 * DTSBE718 00055 * MHDR DTSBE718 00056 * MFAS DTSBE718 00057 * DTSBE718 00058 * DTSBE718 00059 * ALTERNATE INDEX: DTSBE718 00060 * DTSBE718 00061 * NONE. DTSBE718 00062 * DTSBE718 00063 * DTSBE718 00064 * REFERENCE: DTSBE718 00065 * DTSBE718 00066 * NONE. DTSBE718 00067 * DTSBE718 00068 * DTSBE718 00069 * RECORDS UPDATED: DTSBE718 00070 * DTSBE718 00071 * NONE. DTSBE718 00072 * DTSBE718 00073 * DTSBE718 00074 * REPORT RECORDS WRITTEN: DTSBE718 00075 * DTSBE718 00076 * R718 RQC FIELD AUDIT UNIVERSE RECORDS. DTSBE718 00077 * DTSBE718 00078 * DTSBE718 00079 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE718 00080 * DTSBE718 00081 * NONE. DTSBE718 00082 * DTSBE718 00083 * DTSBE718 00084 * MODULES CALLED: DTSBE718 00085 * DTSBE718 00086 * DTSBU001 DATE EDIT/CONVERSION. DTSBE718 00087 * DTSBU910 MASTER FILE I/O. DTSBE718 00088 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE718 00089 * DTSBE718 00090 * DTSBE718 00091 * VERMONT REFERENCE: DTSBE718 00092 * DTSBE718 00093 * NONE. DTSBE718 00094 * DTSBE718 00095 ***** DTSBE718 00096 SKIP3 DTSBE718 00097 ENVIRONMENT DIVISION. DTSBE718 00098 EJECT DTSBE718 00099 DATA DIVISION. DTSBE718 00100 SKIP3 DTSBE718 00101 WORKING-STORAGE SECTION. DTSBE718 001015 77 PAN-VALET PICTURE X(24) VALUE '016DTSBE718 12/18/08'. DTSBE718 00102 SKIP3 DTSBE718 00103 01 WRK-AREA. DTSBE718 00104 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +718.DTSBE718 00105 SKIP1 DTSBE718 00106 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE718'.DTSBE718 00107 SKIP3 DTSBE718 00108 05 ABEND-MSG PIC X(60). DTSBE718 00109 SKIP3 DTSBE718 00110 05 WRK-PARM-PERIOD-START-DATE PIC S9(09) COMP-3. DTSBE718 00111 DTSBE718 00112 05 WRK-PARM-PERIOD-END-DATE PIC S9(09) COMP-3. DTSBE718 00113 EJECT DTSBE718 00114 01 L001-LINK-AREA. DTSBE718 00115 ++INCLUDE DTSIL001 DTSBE718 00116 EJECT DTSBE718 00117 01 L910-LINK-AREA. DTSBE718 00118 ++INCLUDE DTSIL910 DTSBE718 00119 SKIP3 DTSBE718 00120 01 MSKL-REC. DTSBE718 00121 ++INCLUDE DTSIMSKL DTSBE718 00122 SKIP3 DTSBE718 00123 01 MHDR-REC. DTSBE718 00124 ++INCLUDE DTSIMHDR DTSBE718 00125 SKIP3 DTSBE718 00126 01 MFAS-REC. DTSBE718 00127 ++INCLUDE DTSIMFAS DTSBE718 00128 EJECT DTSBE718 00129 01 R718-REC. DTSBE718 00130 ++INCLUDE DTSIR718 DTSBE718 00131 EJECT DTSBE718 00132 LINKAGE SECTION. DTSBE718 00133 SKIP3 DTSBE718 00134 01 LECM-LINK-AREA. DTSBE718 00135 ++INCLUDE DTSILECM DTSBE718 00136 SKIP3 DTSBE718 00137 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE718 00138 15 LECM-PARM-PERIOD-START-DATE PIC X(06). DTSBE718 00139 15 FILLER PIC X(01). DTSBE718 00140 15 LECM-PARM-PERIOD-END-DATE PIC X(06). DTSBE718 00141 15 FILLER PIC X(55). DTSBE718 00142 EJECT DTSBE718 00143 01 MPRF-LINK-REC. DTSBE718 00144 ++INCLUDE DTSIMPRF DTSBE718 00145 EJECT DTSBE718 00146 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE718 00147 MPRF-LINK-REC. DTSBE718 00148 SKIP2 DTSBE718 00149 SKIP2 DTSBE718 00150 IF LECM-PROCESS-88 DTSBE718 00151 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE718 00152 ELSE DTSBE718 00153 IF LECM-INITIALIZE-88 DTSBE718 00154 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE718 00155 ELSE DTSBE718 00156 IF LECM-TERMINATE-88 DTSBE718 00157 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE718 00158 ELSE DTSBE718 00159 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE718 00160 TO ABEND-MSG DTSBE718 00161 PERFORM S999-ABEND THRU S999-EXIT. DTSBE718 00162 SKIP2 DTSBE718 00163 GOBACK. DTSBE718 00164 EJECT DTSBE718 00165 I0000-INITIALIZE. DTSBE718 00166 SKIP2 DTSBE718 00167 MOVE LENGTH OF R718-REC TO R718-LENGTH. DTSBE718 00168 MOVE '718' TO R718-REC-TYPE. DTSBE718 00169 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE718 00170 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE718 00171 DTSBE718 00172 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE718 00173 DTSBE718 00174 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE718 00175 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE718 00176 SKIP2 DTSBE718 00177 I0000-EXIT. DTSBE718 00178 EXIT. DTSBE718 00179 SKIP3 DTSBE718 00180 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE718 00181 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE718 00182 MOVE +0 TO MHDR-EMP-NO. DTSBE718 00183 SET MHDR-HDR-88 TO TRUE. DTSBE718 00184 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE718 00185 PERFORM S910-READ THRU S910-EXIT. DTSBE718 00186 IF L910-NO-REC-88 DTSBE718 00187 MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG DTSBE718 00188 PERFORM S999-ABEND THRU S999-EXIT. DTSBE718 00189 DTSBE718 00190 MOVE MSKL-REC TO MHDR-REC. DTSBE718 00191 DTSBE718 00192 PERFORM I1100-PERIOD-START-DATE THRU I1100-EXIT. DTSBE718 00193 DTSBE718 00194 PERFORM I1200-PERIOD-END-DATE THRU I1200-EXIT. DTSBE718 00195 I1000-EXIT. DTSBE718 00196 EXIT. DTSBE718 00197 SKIP3 DTSBE718 00198 I1100-PERIOD-START-DATE. DTSBE718 00199 IF LECM-PARM-PERIOD-START-DATE = SPACES DTSBE718 00200 MOVE MHDR-CMPL-YEAR-BEGIN-DATE DTSBE718 00201 TO WRK-PARM-PERIOD-START-DATE DTSBE718 00202 ELSE DTSBE718 00203 MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X DTSBE718 00204 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE718 00205 IF L001-VALID-DATE DTSBE718 00206 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE718 00207 ELSE DTSBE718 00208 MOVE 'LECM-PARM-PERIOD-START-DATE NOT VALID' DTSBE718 00209 TO ABEND-MSG DTSBE718 00210 PERFORM S999-ABEND THRU S999-EXIT. DTSBE718 00211 I1100-EXIT. DTSBE718 00212 EXIT. DTSBE718 00213 SKIP3 DTSBE718 00214 I1200-PERIOD-END-DATE. DTSBE718 00215 IF LECM-PARM-PERIOD-END-DATE = SPACES DTSBE718 00216 MOVE MHDR-CMPL-YEAR-END-DATE DTSBE718 00217 TO WRK-PARM-PERIOD-END-DATE DTSBE718 00218 ELSE DTSBE718 00219 MOVE LECM-PARM-PERIOD-END-DATE TO L001-CAL-6-DATE-X DTSBE718 00220 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE718 00221 IF L001-VALID-DATE DTSBE718 00222 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-END-DATE DTSBE718 00223 ELSE DTSBE718 00224 MOVE 'LECM-PARM-PERIOD-END-DATE NOT VALID' DTSBE718 00225 TO ABEND-MSG DTSBE718 00226 PERFORM S999-ABEND THRU S999-EXIT. DTSBE718 00227 DTSBE718 00228 IF WRK-PARM-PERIOD-END-DATE < WRK-PARM-PERIOD-START-DATE DTSBE718 00229 MOVE 'PERIOD-END-DATE LESS THAN PERIOD-START-DATE' DTSBE718 00230 TO ABEND-MSG DTSBE718 00231 PERFORM S999-ABEND THRU S999-EXIT. DTSBE718 00232 I1200-EXIT. DTSBE718 00233 EXIT. DTSBE718 00234 EJECT DTSBE718 00235 P0000-PROCESS. DTSBE718 00236 ** IF MPRF-NO-MFAS-88 DTSBE718 00237 ** GO TO P0000-EXIT. DTSBE718 00238 DTSBE718 00239 IF MPRF-CLASS-SELF-INS-88 DTSBE718 00240 GO TO P0000-EXIT. DTSBE718 00241 DTSBE718 00242 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSBE718 00243 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBE718 00244 SET MFAS-FAS-88 TO TRUE. DTSBE718 00245 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBE718 00246 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE718 00247 PERFORM P1000-SCAN-MFAS THRU P1000-EXIT DTSBE718 00248 UNTIL L910-NO-REC-88. DTSBE718 00249 P0000-EXIT. DTSBE718 00250 EXIT. DTSBE718 00251 SKIP3 DTSBE718 00252 P1000-SCAN-MFAS. DTSBE718 00253 MOVE MSKL-REC TO MFAS-REC. DTSBE718 00254 DTSBE718 00255 IF (MFAS-PROCESSED-DATE < WRK-PARM-PERIOD-START-DATE) DTSBE718 00256 OR DTSBE718 00257 (MFAS-PROCESSED-DATE > WRK-PARM-PERIOD-END-DATE) DTSBE718 00258 NEXT SENTENCE DTSBE718 00259 ELSE DTSBE718 00260 PERFORM P1100-GENERATE-R718 THRU P1100-EXIT. DTSBE718 00261 DTSBE718 00262 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE718 00263 P1000-EXIT. DTSBE718 00264 EXIT. DTSBE718 00265 SKIP3 DTSBE718 00266 P1100-GENERATE-R718. DTSBE718 00267 MOVE MPRF-EMP-NO TO R718-EMP-NO. DTSBE718 00268 DTSBE718 00269 SET R718-TRANS-TYPE-OTHER-88 TO TRUE. DTSBE718 00270 DTSBE718 00271 PERFORM DTSBE718 00272 VARYING MFAS-SEL-IDX FROM 1 BY 1 DTSBE718 00273 UNTIL MFAS-SEL-IDX > MFAS-SEL-CNT DTSBE718 00274 IF MFAS-AUDIT-SEL-RANDOM-88 (MFAS-SEL-IDX) DTSBE718 00275 SET R718-TRANS-TYPE-RANDOM-88 TO TRUE DTSBE718 00276 END-IF DTSBE718 00277 END-PERFORM. DTSBE718 00278 DTSBE718 00279 MOVE MFAS-PROCESSED-DATE TO R718-PROCESSED-DATE. DTSBE718 00280 DTSBE718 00281 PERFORM S946-WRITE-R718 THRU S946-EXIT. DTSBE718 00282 P1100-EXIT. DTSBE718 00283 EXIT. DTSBE718 00284 EJECT DTSBE718 00285 T0000-TERMINATE. DTSBE718 00286 SKIP2 DTSBE718 00287 SKIP2 DTSBE718 00288 T0000-EXIT. DTSBE718 00289 EXIT. DTSBE718 00290 EJECT DTSBE718 00291 S001-FROM-FED-8. DTSBE718 00292 SET L001-FROM-FED-8 TO TRUE. DTSBE718 00293 GO TO S001-DATE. DTSBE718 00294 SKIP1 DTSBE718 00295 S001-FROM-ABS-DAY. DTSBE718 00296 SET L001-FROM-ABS-DAY TO TRUE. DTSBE718 00297 GO TO S001-DATE. DTSBE718 00298 SKIP1 DTSBE718 00299 S001-FROM-CAL-6. DTSBE718 00300 SET L001-FROM-CAL-6 TO TRUE. DTSBE718 00301 GO TO S001-DATE. DTSBE718 00302 SKIP1 DTSBE718 00303 S001-DATE. DTSBE718 00304 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE718 00305 S001-EXIT. DTSBE718 00306 EXIT. DTSBE718 00307 SKIP3 DTSBE718 00308 S910-READ. DTSBE718 00309 SET L910-READ-88 TO TRUE. DTSBE718 00310 GO TO S910-MSTR-IO. DTSBE718 00311 SKIP1 DTSBE718 00312 S910-START-BROWSE. DTSBE718 00313 SET L910-START-BROWSE-88 TO TRUE. DTSBE718 00314 GO TO S910-MSTR-IO. DTSBE718 00315 SKIP1 DTSBE718 00316 S910-READ-NEXT. DTSBE718 00317 SET L910-READ-NEXT-88 TO TRUE. DTSBE718 00318 GO TO S910-MSTR-IO. DTSBE718 00319 SKIP1 DTSBE718 00320 S910-COUNT. DTSBE718 00321 SET L910-COUNT-88 TO TRUE. DTSBE718 00322 GO TO S910-MSTR-IO. DTSBE718 00323 SKIP1 DTSBE718 00324 S910-MSTR-IO. DTSBE718 00325 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE718 00326 MSKL-REC. DTSBE718 00327 S910-EXIT. DTSBE718 00328 EXIT. DTSBE718 00329 SKIP3 DTSBE718 00330 S946-WRITE-R718. DTSBE718 00331 CALL 'DTSBU946' USING R718-REC. DTSBE718 00332 GO TO S946-EXIT. DTSBE718 00333 SKIP1 DTSBE718 00334 S946-EXIT. DTSBE718 00335 EXIT. DTSBE718 00336 SKIP3 DTSBE718 00337 S999-ABEND. DTSBE718 00338 DISPLAY '*** DTSBE718 ABENDING. ' DTSBE718 00339 ABEND-MSG. DTSBE718 00340 SKIP1 DTSBE718 00341 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE718 00342 S999-EXIT. DTSBE718 00343 EXIT. DTSBE718