00001 IDENTIFICATION DIVISION. 02/07/12 00002 PROGRAM-ID. DTSBE612. DTSBE612 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009 00004 DATE-WRITTEN. MARCH 1995. DTSBE612 00005 DATE-COMPILED. DTSBE612 00006 SKIP3 DTSBE612 00007 ***** DTSBE612 00008 * DTSBE612 00009 * FUNCTION: PROCESSED AUDIT ASSIGNMENTS WITH UNRECORDED DTSBE612 00010 * QUARTER RESULTS EXTRACT DTSBE612 00011 * DTSBE612 00012 * DTSBE612 00013 * MODIFICATION LOG: DTSBE612 00014 * DTSBE612 00015 * 03/23/95 INITIAL DEVELOPMENT. DTSBE612 00016 * WORK ORDER: CR060 PROGRAMMER: RHC DTSBE612 00017 * DTSBE612 00018 * 12/17/98 MODIFIED TO MEET DUTAS PROGRAM SPECIFICATIONS. DTSBE612 00019 * WORK ORDER: PROGRAMMER: DVS DTSBE612 00020 * DTSBE612 00021 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE612 00022 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE612 00023 * WORK ORDER: PROGRAMMER: XXX DTSBE612 00024 * DTSBE612 00025 * DTSBE612 00026 * DESCRIPTION: DTSBE612 00027 * DTSBE612 00028 * DTSBE612 00029 * INITIATION: DTSBE612 00030 * DTSBE612 00031 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE612 00032 * DTSBE612 00033 * EDIT PARAMTERS (SEE 612R1). DTSBE612 00034 * DTSBE612 00035 * DTSBE612 00036 * PROCESSING: DTSBE612 00037 * DTSBE612 00038 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (612R1). DTSBE612 00039 * DTSBE612 00040 * DTSBE612 00041 * TERMINATION: DTSBE612 00042 * DTSBE612 00043 * NONE. DTSBE612 00044 * DTSBE612 00045 * DTSBE612 00046 * RECORDS READ: DTSBE612 00047 * DTSBE612 00048 * MASTER: DTSBE612 00049 * DTSBE612 00050 * MFAS DTSBE612 00051 * MAUR DTSBE612 00052 * MAUY. DTSBE612 00053 * DTSBE612 00054 * DTSBE612 00055 * ALTERNATE INDEX: DTSBE612 00056 * DTSBE612 00057 * NONE. DTSBE612 00058 * DTSBE612 00059 * DTSBE612 00060 * REFERENCE: DTSBE612 00061 * DTSBE612 00062 * NONE. DTSBE612 00063 * DTSBE612 00064 * DTSBE612 00065 * RECORDS UPDATED: DTSBE612 00066 * DTSBE612 00067 * NONE. DTSBE612 00068 * DTSBE612 00069 * DTSBE612 00070 * REPORT RECORDS WRITTEN: DTSBE612 00071 * DTSBE612 00072 * R612 PROCESSED AUDIT ASSIGNMENTS WITH UNRECORDED DTSBE612 00073 * QUARTER RESULTS. DTSBE612 00074 * DTSBE612 00075 * DTSBE612 00076 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE612 00077 * DTSBE612 00078 * NONE. DTSBE612 00079 * DTSBE612 00080 * DTSBE612 00081 * MODULES CALLED: DTSBE612 00082 * DTSBE612 00083 * DTSBU001 DATE EDIT/CONVERSION. DTSBE612 00084 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBE612 00085 * DTSBU910 MASTER FILE I/O. DTSBE612 00086 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE612 00087 * DTSBE612 00088 * DTSBE612 00089 * VERMONT REFERENCE: DTSBE612 00090 * DTSBE612 00091 * NONE. DTSBE612 00092 * DTSBE612 00093 ***** DTSBE612 00094 SKIP3 DTSBE612 00095 ENVIRONMENT DIVISION. DTSBE612 00096 SKIP3 DTSBE612 00097 DATA DIVISION. DTSBE612 00098 EJECT DTSBE612 00099 WORKING-STORAGE SECTION. DTSBE612 000995 77 PAN-VALET PICTURE X(24) VALUE '009DTSBE612 02/07/12'. DTSBE612 00100 SKIP3 DTSBE612 00101 01 WRK-AREA. DTSBE612 00102 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +612.DTSBE612 00103 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE612'.DTSBE612 00104 05 ABEND-MSG PIC X(60). DTSBE612 00105 DTSBE612 00106 DTSBE612 00107 05 SUB-FIRST-Q PIC 9(01). DTSBE612 00108 05 SUB-LAST-Q PIC 9(01). DTSBE612 00109 DTSBE612 00110 ++INCLUDE OJRWE612 DTSBE612 00111 EJECT DTSBE612 00112 01 L001-LINK-AREA. DTSBE612 00113 ++INCLUDE DTSIL001 DTSBE612 00114 EJECT DTSBE612 00115 01 L004-LINK-AREA. DTSBE612 00116 ++INCLUDE DTSIL004 DTSBE612 00117 EJECT DTSBE612 00118 01 L910-LINK-AREA. DTSBE612 00119 ++INCLUDE DTSIL910 DTSBE612 00120 SKIP3 DTSBE612 00121 01 MSKL-REC. DTSBE612 00122 ++INCLUDE DTSIMSKL DTSBE612 00123 SKIP3 DTSBE612 00124 01 MFAS-REC. DTSBE612 00125 ++INCLUDE DTSIMFAS DTSBE612 00126 SKIP3 DTSBE612 00127 01 MAUR-REC. DTSBE612 00128 ++INCLUDE DTSIMAUR DTSBE612 00129 SKIP3 DTSBE612 00130 01 MAUY-REC. DTSBE612 00131 ++INCLUDE DTSIMAUY DTSBE612 00132 EJECT DTSBE612 00133 01 R612-REC. DTSBE612 00134 ++INCLUDE DTSIR612 DTSBE612 00135 EJECT DTSBE612 00136 LINKAGE SECTION. DTSBE612 00137 SKIP3 DTSBE612 00138 01 LECM-LINK-AREA. DTSBE612 00139 ++INCLUDE DTSILECM DTSBE612 00140 SKIP3 DTSBE612 00141 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE612 00142 15 LECM-PARM-START-DATE PIC X(06). DTSBE612 00143 15 FILLER PIC X(01). DTSBE612 00144 15 LECM-PARM-END-DATE PIC X(06). DTSBE612 00145 15 FILLER PIC X(55). DTSBE612 00146 EJECT DTSBE612 00147 01 MPRF-LINK-REC. DTSBE612 00148 ++INCLUDE DTSIMPRF DTSBE612 00149 EJECT DTSBE612 00150 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE612 00151 MPRF-LINK-REC. DTSBE612 00152 DTSBE612 00153 EVALUATE TRUE DTSBE612 00154 WHEN LECM-PROCESS-88 DTSBE612 00155 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE612 00156 DTSBE612 00157 WHEN LECM-INITIALIZE-88 DTSBE612 00158 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE612 00159 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE612 00160 IF WRK-EDIT-FAILED-88 DTSBE612 00161 PERFORM S999-ABEND THRU S999-EXIT DTSBE612 00162 END-IF DTSBE612 00163 DTSBE612 00164 WHEN LECM-TERMINATE-88 DTSBE612 00165 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE612 00166 DTSBE612 00167 WHEN OTHER DTSBE612 00168 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE612 00169 TO ABEND-MSG DTSBE612 00170 PERFORM S999-ABEND THRU S999-EXIT. DTSBE612 00171 GOBACK. DTSBE612 00172 EJECT DTSBE612 00173 I0000-INITIALIZE. DTSBE612 00174 DTSBE612 00175 SKIP2 DTSBE612 00176 MOVE LENGTH OF R612-REC TO R612-LENGTH. DTSBE612 00177 MOVE '612' TO R612-REC-TYPE. DTSBE612 00178 DTSBE612 00179 MOVE LECM-PARM-START-DATE TO DTSBE612 00180 OJR-PARM-START-DATE. DTSBE612 00181 MOVE LECM-PARM-END-DATE TO DTSBE612 00182 OJR-PARM-END-DATE. DTSBE612 00183 MOVE LECM-CURR-RUN-DATE TO DTSBE612 00184 OJR-CURR-RUN-DATE. DTSBE612 00185 DTSBE612 00186 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE612 00187 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE612 00188 DTSBE612 00189 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE612 00190 DTSBE612 00191 MOVE WRK-PARM-END-DATE TO R612-PARM-END-DATE. DTSBE612 00192 MOVE WRK-PARM-START-DATE TO R612-PARM-START-DATE. DTSBE612 00193 DTSBE612 00194 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE612 00195 DTSBE612 00196 I0000-EXIT. EXIT. DTSBE612 00197 DTSBE612 00198 ++INCLUDE OJRPE612 DTSBE612 00199 DTSBE612 00200 P0000-PROCESS. DTSBE612 00201 DTSBE612 00202 IF MPRF-NO-MFAS-88 DTSBE612 00203 GO TO P0000-EXIT. DTSBE612 00204 DTSBE612 00205 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBE612 00206 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE612 00207 SET MSKL-FAS-88 TO TRUE. DTSBE612 00208 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE612 00209 PERFORM P1000-SCAN-MFAS THRU P1000-EXIT DTSBE612 00210 UNTIL L910-NO-REC-88. DTSBE612 00211 DTSBE612 00212 P0000-EXIT. EXIT. DTSBE612 00213 SKIP3 DTSBE612 00214 P1000-SCAN-MFAS. DTSBE612 00215 DTSBE612 00216 MOVE MSKL-REC TO MFAS-REC. DTSBE612 00217 DTSBE612 00218 IF MFAS-AUDIT-88 DTSBE612 00219 AND MFAS-STATUS-PROCESSED-88 DTSBE612 00220 AND MFAS-PROCESSED-DATE NOT < R612-PARM-START-DATE DTSBE612 00221 AND MFAS-PROCESSED-DATE NOT > R612-PARM-END-DATE DTSBE612 00222 PERFORM P1100-PROCESSED-AUDIT THRU P1100-EXIT DTSBE612 00223 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA DTSBE612 00224 PERFORM S910-READ THRU S910-EXIT DTSBE612 00225 IF L910-NO-REC-88 DTSBE612 00226 MOVE 'LOGIC ERROR IN P1000' TO ABEND-MSG DTSBE612 00227 PERFORM S999-ABEND THRU S999-EXIT. DTSBE612 00228 DTSBE612 00229 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE612 00230 DTSBE612 00231 P1000-EXIT. EXIT. DTSBE612 00232 EJECT DTSBE612 00233 P1100-PROCESSED-AUDIT. DTSBE612 00234 DTSBE612 00235 MOVE +0 TO R612-MISSING-YRQ-CNT. DTSBE612 00236 DTSBE612 00237 MOVE LOW-VALUE TO MAUR-KEY-AREA. DTSBE612 00238 MOVE MFAS-EMP-NO TO MAUR-EMP-NO. DTSBE612 00239 SET MAUR-AUR-88 TO TRUE. DTSBE612 00240 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSBE612 00241 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSBE612 00242 PERFORM S910-READ THRU S910-EXIT. DTSBE612 00243 IF L910-NO-REC-88 DTSBE612 00244 GO TO P1100-EXIT. DTSBE612 00245 DTSBE612 00246 MOVE MSKL-REC TO MAUR-REC. DTSBE612 00247 MOVE MAUR-FIRST-YRQ TO FIRST-YRQ. DTSBE612 00248 MOVE MAUR-LAST-YRQ TO LAST-YRQ. DTSBE612 00249 PERFORM P1110-CHECK-YR THRU P1110-EXIT DTSBE612 00250 VARYING OUT-YR FROM FIRST-YR BY 1 DTSBE612 00251 UNTIL OUT-YR GREATER THAN LAST-YR. DTSBE612 00252 DTSBE612 00253 IF R612-MISSING-YRQ-CNT > 0 DTSBE612 00254 MOVE MFAS-ASSIGN-NO TO R612-ASSIGN-NO DTSBE612 00255 MOVE MFAS-EMP-NO TO R612-EMP-NO DTSBE612 00256 MOVE MAUR-FIRST-YRQ TO R612-FIRST-YRQ DTSBE612 00257 MOVE MAUR-LAST-YRQ TO R612-LAST-YRQ DTSBE612 00258 PERFORM S946-WRITE-R612 THRU S946-EXIT. DTSBE612 00259 DTSBE612 00260 P1100-EXIT. EXIT. DTSBE612 00261 EJECT DTSBE612 00262 P1110-CHECK-YR. DTSBE612 00263 DTSBE612 00264 MOVE LOW-VALUE TO MAUY-KEY-AREA. DTSBE612 00265 MOVE MFAS-EMP-NO TO MAUY-EMP-NO. DTSBE612 00266 SET MAUY-AUY-88 TO TRUE. DTSBE612 00267 MOVE MFAS-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSBE612 00268 MOVE OUT-YR TO MAUY-CALENDAR-YEAR. DTSBE612 00269 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSBE612 00270 PERFORM S910-READ THRU S910-EXIT. DTSBE612 00271 DTSBE612 00272 IF OUT-YR = FIRST-YR DTSBE612 00273 MOVE FIRST-Q TO SUB-FIRST-Q DTSBE612 00274 ELSE DTSBE612 00275 MOVE 1 TO SUB-FIRST-Q. DTSBE612 00276 DTSBE612 00277 IF OUT-YR = LAST-YR DTSBE612 00278 MOVE LAST-Q TO SUB-LAST-Q DTSBE612 00279 ELSE DTSBE612 00280 MOVE 4 TO SUB-LAST-Q. DTSBE612 00281 DTSBE612 00282 PERFORM P1111-LOAD-MISSING THRU P1111-EXIT DTSBE612 00283 VARYING OUT-Q FROM FIRST-Q BY 1 DTSBE612 00284 UNTIL OUT-Q GREATER THAN LAST-Q. DTSBE612 00285 DTSBE612 00286 P1110-EXIT. EXIT. DTSBE612 00287 SKIP3 DTSBE612 00288 P1111-LOAD-MISSING. DTSBE612 00289 DTSBE612 00290 IF L910-OK-88 DTSBE612 00291 MOVE MSKL-REC TO MAUY-REC DTSBE612 00292 IF MAUY-QTR-AUDITED-88 (OUT-Q) DTSBE612 00293 GO TO P1111-EXIT. DTSBE612 00294 SKIP3 DTSBE612 00295 IF R612-MISSING-YRQ-CNT = WRK-CNT-MAX DTSBE612 00296 MOVE ALL-NINES-YRQ DTSBE612 00297 TO R612-MISSING-YRQ (R612-MISSING-YRQ-CNT) DTSBE612 00298 ELSE DTSBE612 00299 ADD +1 TO R612-MISSING-YRQ-CNT DTSBE612 00300 MOVE OUT-YRQ DTSBE612 00301 TO R612-MISSING-YRQ (R612-MISSING-YRQ-CNT). DTSBE612 00302 DTSBE612 00303 P1111-EXIT. EXIT. DTSBE612 00304 EJECT DTSBE612 00305 S001-FROM-CAL-6. DTSBE612 00306 SET L001-FROM-CAL-6 TO TRUE. DTSBE612 00307 GO TO S001-DATE. DTSBE612 00308 DTSBE612 00309 S001-DATE. DTSBE612 00310 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE612 00311 S001-EXIT. EXIT. DTSBE612 00312 SKIP3 DTSBE612 00313 S004-FROM-DATE. DTSBE612 00314 SET L004-FROM-DATE TO TRUE. DTSBE612 00315 GO TO S004-YRQ. DTSBE612 00316 DTSBE612 00317 S004-YRQ. DTSBE612 00318 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE612 00319 S004-EXIT. EXIT. DTSBE612 00320 EJECT DTSBE612 00321 S910-READ. DTSBE612 00322 SET L910-READ-88 TO TRUE. DTSBE612 00323 GO TO S910-MSTR-IO. DTSBE612 00324 DTSBE612 00325 S910-START-BROWSE. DTSBE612 00326 SET L910-START-BROWSE-88 TO TRUE. DTSBE612 00327 GO TO S910-MSTR-IO. DTSBE612 00328 DTSBE612 00329 S910-READ-NEXT. DTSBE612 00330 SET L910-READ-NEXT-88 TO TRUE. DTSBE612 00331 GO TO S910-MSTR-IO. DTSBE612 00332 DTSBE612 00333 *S910-COUNT. DTSBE612 00334 * SET L910-COUNT-88 TO TRUE. DTSBE612 00335 * GO TO S910-MSTR-IO. DTSBE612 00336 DTSBE612 00337 S910-MSTR-IO. DTSBE612 00338 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE612 00339 MSKL-REC. DTSBE612 00340 S910-EXIT. EXIT. DTSBE612 00341 SKIP3 DTSBE612 00342 S946-WRITE-R612. DTSBE612 00343 CALL 'DTSBU946' USING R612-REC. DTSBE612 00344 MOVE 'Y' TO WRK-RECORD-WRITTEN-IND. DTSBE612 00345 S946-EXIT. EXIT. DTSBE612 00346 SKIP3 DTSBE612 00347 S999-ABEND. DTSBE612 00348 DISPLAY '*** DTSBE612 ABENDING. ' ABEND-MSG. DTSBE612 00349 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE612 00350 S999-EXIT. EXIT. DTSBE612 00351 EJECT DTSBE612 00352 T0000-TERMINATE. DTSBE612 00353 DTSBE612 00354 IF WRK-RECORD-WRITTEN-IND = 'N' DTSBE612 00355 MOVE +0 TO R612-ASSIGN-NO DTSBE612 00356 PERFORM S946-WRITE-R612 THRU S946-EXIT. DTSBE612 00357 DTSBE612 00358 T0000-EXIT. EXIT. DTSBE612