00001 IDENTIFICATION DIVISION. 02/07/12 00002 PROGRAM-ID. DTSBE606. DTSBE606 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009 00004 DATE-WRITTEN. AUGUST 1994. DTSBE606 00005 DATE-COMPILED. DTSBE606 00006 SKIP3 DTSBE606 00007 ***** DTSBE606 00008 * DTSBE606 00009 * FUNCTION: ASSIGNMENT SUMMARY BY FIELD REPRESENTATIVE DTSBE606 00010 * EXTRACT. DTSBE606 00011 * DTSBE606 00012 * DTSBE606 00013 * MODIFICATION LOG: DTSBE606 00014 * DTSBE606 00015 * 09/20/94 INITIAL DEVELOPMENT. DTSBE606 00016 * WORK ORDER: PROGRAMMER: RHC DTSBE606 00017 * DTSBE606 00018 * 01/30/95 ADD SELECTION CRITERIA TO RECORDS. DTSBE606 00019 * WORK ORDER: CR043 PROGRAMMER: RHC DTSBE606 00020 * DTSBE606 00021 * 11/25/98 CHANGE TO MEET DUTAS PROGRAMMING SPECIFICATION DTSBE606 00022 * WORK ORDER: PROGRAMMER: DVS DTSBE606 00023 * DTSBE606 00024 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE606 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE606 00026 * WORK ORDER: PROGRAMMER: XXX DTSBE606 00027 * DTSBE606 00028 * DTSBE606 00029 * DESCRIPTION: DTSBE606 00030 * DTSBE606 00031 * DTSBE606 00032 * INITIATION: DTSBE606 00033 * DTSBE606 00034 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE606 00035 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE606 00036 * DTSBE606 00037 * EDIT PARAMTERS (SEE 606R1). DTSBE606 00038 * DTSBE606 00039 * DTSBE606 00040 * PROCESSING: DTSBE606 00041 * DTSBE606 00042 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (606R1). DTSBE606 00043 * DTSBE606 00044 * DTSBE606 00045 * TERMINATION: DTSBE606 00046 * DTSBE606 00047 * NONE. DTSBE606 00048 * DTSBE606 00049 * DTSBE606 00050 * RECORDS READ: DTSBE606 00051 * DTSBE606 00052 * MASTER: DTSBE606 00053 * DTSBE606 00054 * MFAS DTSBE606 00055 * MAUR DTSBE606 00056 * MAUY DTSBE606 00057 * DTSBE606 00058 * DTSBE606 00059 * ALTERNATE INDEX: DTSBE606 00060 * DTSBE606 00061 * NONE. DTSBE606 00062 * DTSBE606 00063 * DTSBE606 00064 * REFERENCE: DTSBE606 00065 * DTSBE606 00066 * NONE. DTSBE606 00067 * DTSBE606 00068 * DTSBE606 00069 * RECORDS UPDATED: DTSBE606 00070 * DTSBE606 00071 * NONE. DTSBE606 00072 * DTSBE606 00073 * DTSBE606 00074 * REPORT RECORDS WRITTEN: DTSBE606 00075 * DTSBE606 00076 * R606 ASSIGNMENT SUMMPARY BE FIELD REPRESENTATIVE. DTSBE606 00077 * DTSBE606 00078 * DTSBE606 00079 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE606 00080 * DTSBE606 00081 * NONE. DTSBE606 00082 * DTSBE606 00083 * DTSBE606 00084 * MODULES CALLED: DTSBE606 00085 * DTSBE606 00086 * DTSBU001 DATE CONVERSION/EDIT. DTSBE606 00087 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBE606 00088 * DTSBU910 MASTER FILE I/O. DTSBE606 00089 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE606 00090 * DTSBE606 00091 * DTSBE606 00092 * VERMONT REFERENCE: DTSBE606 00093 * DTSBE606 00094 * TXBE362 DTSBE606 00095 * DTSBE606 00096 ***** DTSBE606 00097 SKIP3 DTSBE606 00098 ENVIRONMENT DIVISION. DTSBE606 00099 SKIP3 DTSBE606 00100 DATA DIVISION. DTSBE606 00101 EJECT DTSBE606 00102 WORKING-STORAGE SECTION. DTSBE606 001025 77 PAN-VALET PICTURE X(24) VALUE '009DTSBE606 02/07/12'. DTSBE606 00103 SKIP3 DTSBE606 00104 01 WRK-AREA. DTSBE606 00105 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +606.DTSBE606 00106 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE606'.DTSBE606 00107 05 ABEND-MSG PIC X(60). DTSBE606 00108 DTSBE606 00109 05 WRK-CNT PIC S9(04) COMP. DTSBE606 00110 DTSBE606 00111 SKIP3 DTSBE606 00112 EJECT DTSBE606 00113 01 L001-LINK-AREA. DTSBE606 00114 ++INCLUDE DTSIL001 DTSBE606 00115 EJECT DTSBE606 00116 01 L004-LINK-AREA. DTSBE606 00117 ++INCLUDE DTSIL004 DTSBE606 00118 EJECT DTSBE606 00119 01 L910-LINK-AREA. DTSBE606 00120 ++INCLUDE DTSIL910 DTSBE606 00121 SKIP3 DTSBE606 00122 01 MSKL-REC. DTSBE606 00123 ++INCLUDE DTSIMSKL DTSBE606 00124 SKIP3 DTSBE606 00125 01 MHDR-REC. DTSBE606 00126 ++INCLUDE DTSIMHDR DTSBE606 00127 SKIP3 DTSBE606 00128 01 MFAS-REC. DTSBE606 00129 ++INCLUDE DTSIMFAS DTSBE606 00130 SKIP3 DTSBE606 00131 01 MAUR-REC. DTSBE606 00132 ++INCLUDE DTSIMAUR DTSBE606 00133 SKIP3 DTSBE606 00134 01 MAUY-REC. DTSBE606 00135 ++INCLUDE DTSIMAUY DTSBE606 00136 EJECT DTSBE606 00137 01 MMAX-CONSTANT-AREA. DTSBE606 00138 ++INCLUDE DTSIMMAX DTSBE606 00139 EJECT DTSBE606 00140 01 R606-REC. DTSBE606 00141 ++INCLUDE DTSIR606 DTSBE606 00142 EJECT DTSBE606 00143 ++INCLUDE OJRWE606 DTSBE606 00144 EJECT DTSBE606 00145 LINKAGE SECTION. DTSBE606 00146 SKIP3 DTSBE606 00147 01 LECM-LINK-AREA. DTSBE606 00148 ++INCLUDE DTSILECM DTSBE606 00149 SKIP3 DTSBE606 00150 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE606 00151 15 LECM-PARM-COMPLETED-START-DATE PIC X(06). DTSBE606 00152 15 FILLER PIC X(01). DTSBE606 00153 15 LECM-PARM-COMPLETED-END-DATE PIC X(06). DTSBE606 00154 15 FILLER PIC X(01). DTSBE606 00155 15 LECM-PARM-PROCESSED-START-DATE PIC X(06). DTSBE606 00156 15 FILLER PIC X(01). DTSBE606 00157 15 LECM-PARM-PROCESSED-END-DATE PIC X(06). DTSBE606 00158 15 FILLER PIC X(01). DTSBE606 00159 15 LECM-PARM-ASSIGN-AREA DTSBE606 00160 OCCURS 5 TIMES DTSBE606 00161 INDEXED BY LECM-PARM-ASSIGN-IDX. DTSBE606 00162 20 LECM-PARM-ASSIGN-TYPE PIC X(02). DTSBE606 00163 20 FILLER PIC X(01). DTSBE606 00164 15 FILLER PIC X(25). DTSBE606 00165 EJECT DTSBE606 00166 01 MPRF-LINK-REC. DTSBE606 00167 ++INCLUDE DTSIMPRF DTSBE606 00168 EJECT DTSBE606 00169 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE606 00170 MPRF-LINK-REC. DTSBE606 00171 EVALUATE TRUE DTSBE606 00172 WHEN LECM-PROCESS-88 DTSBE606 00173 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE606 00174 DTSBE606 00175 WHEN LECM-INITIALIZE-88 DTSBE606 00176 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE606 00177 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE606 00178 IF WRK-EDIT-FAILED-88 DTSBE606 00179 PERFORM S999-ABEND THRU S999-EXIT DTSBE606 00180 END-IF DTSBE606 00181 DTSBE606 00182 WHEN LECM-TERMINATE-88 DTSBE606 00183 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE606 00184 DTSBE606 00185 WHEN OTHER DTSBE606 00186 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE606 00187 TO ABEND-MSG DTSBE606 00188 PERFORM S999-ABEND THRU S999-EXIT. DTSBE606 00189 SKIP3 DTSBE606 00190 GOBACK. DTSBE606 00191 EJECT DTSBE606 00192 I0000-INITIALIZE. DTSBE606 00193 MOVE LENGTH OF R606-REC TO R606-LENGTH. DTSBE606 00194 MOVE '606' TO R606-REC-TYPE. DTSBE606 00195 DTSBE606 00196 MOVE LECM-PARM-COMPLETED-START-DATE TO DTSBE606 00197 OJR-PARM-COMPLETED-START-DATE. DTSBE606 00198 MOVE LECM-PARM-COMPLETED-END-DATE TO DTSBE606 00199 OJR-PARM-COMPLETED-END-DATE. DTSBE606 00200 MOVE LECM-PARM-PROCESSED-START-DATE TO DTSBE606 00201 OJR-PARM-PROCESSED-START-DATE. DTSBE606 00202 MOVE LECM-PARM-PROCESSED-END-DATE TO DTSBE606 00203 OJR-PARM-PROCESSED-END-DATE. DTSBE606 00204 DTSBE606 00205 PERFORM I0001-MOVE-ASSIGN THRU I0001-EXIT DTSBE606 00206 VARYING OJR-PARM-ASSIGN-IDX DTSBE606 00207 FROM 1 BY 1 UNTIL DTSBE606 00208 OJR-PARM-ASSIGN-IDX DTSBE606 00209 > 5. DTSBE606 00210 DTSBE606 00211 DTSBE606 00212 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE606 00213 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE606 00214 DTSBE606 00215 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE606 00216 MOVE +0 TO MHDR-EMP-NO. DTSBE606 00217 SET MHDR-HDR-88 TO TRUE. DTSBE606 00218 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE606 00219 PERFORM S910-READ THRU S910-EXIT. DTSBE606 00220 IF L910-NO-REC-88 DTSBE606 00221 MOVE 'MASTER FILE HEADER RECORD MISSING' DTSBE606 00222 TO ABEND-MSG DTSBE606 00223 PERFORM S999-ABEND THRU S999-EXIT. DTSBE606 00224 MOVE MSKL-REC TO MHDR-REC. DTSBE606 00225 DTSBE606 00226 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE606 00227 DTSBE606 00228 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE606 00229 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE606 00230 DTSBE606 00231 I0000-EXIT. DTSBE606 00232 EXIT. DTSBE606 00233 I0001-MOVE-ASSIGN. DTSBE606 00234 DTSBE606 00235 MOVE LECM-PARM-ASSIGN-TYPE (OJR-PARM-ASSIGN-IDX) TO DTSBE606 00236 OJR-PARM-ASSIGN-TYPE (OJR-PARM-ASSIGN-IDX). DTSBE606 00237 DTSBE606 00238 I0001-EXIT. DTSBE606 00239 ++INCLUDE OJRPE606 DTSBE606 00240 P0000-PROCESS. DTSBE606 00241 IF MPRF-NO-MFAS-88 DTSBE606 00242 GO TO P0000-EXIT. DTSBE606 00243 DTSBE606 00244 MOVE LOW-VALUES TO MFAS-KEY-AREA. DTSBE606 00245 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBE606 00246 SET MFAS-FAS-88 TO TRUE. DTSBE606 00247 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA. DTSBE606 00248 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE606 00249 PERFORM P1000-SCAN-MFAS THRU P1000-EXIT DTSBE606 00250 UNTIL L910-NO-REC-88. DTSBE606 00251 P0000-EXIT. DTSBE606 00252 EXIT. DTSBE606 00253 SKIP3 DTSBE606 00254 P1000-SCAN-MFAS. DTSBE606 00255 MOVE MSKL-REC TO MFAS-REC. DTSBE606 00256 DTSBE606 00257 IF (MFAS-AUDIT-88) DTSBE606 00258 AND DTSBE606 00259 (MFAS-STATUS-PROCESSED-88) DTSBE606 00260 PERFORM P1100-PROCESSED-AUDIT THRU P1100-EXIT DTSBE606 00261 MOVE MFAS-KEY-AREA TO MSKL-KEY-AREA DTSBE606 00262 PERFORM S910-READ THRU S910-EXIT DTSBE606 00263 IF L910-NO-REC-88 DTSBE606 00264 MOVE 'LOGIC ERROR IN P1000' TO ABEND-MSG DTSBE606 00265 PERFORM S999-ABEND THRU S999-EXIT. DTSBE606 00266 DTSBE606 00267 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE606 00268 P1000-EXIT. DTSBE606 00269 EXIT. DTSBE606 00270 EJECT DTSBE606 00271 P1100-PROCESSED-AUDIT. DTSBE606 00272 IF (MFAS-COMPLETED-DATE < WRK-PARM-COMPLETED-START-DATE) DTSBE606 00273 OR DTSBE606 00274 (MFAS-COMPLETED-DATE > WRK-PARM-COMPLETED-END-DATE) DTSBE606 00275 GO TO P1100-EXIT. DTSBE606 00276 DTSBE606 00277 IF (MFAS-PROCESSED-DATE < WRK-PARM-PROCESSED-START-DATE) DTSBE606 00278 OR DTSBE606 00279 (MFAS-PROCESSED-DATE > WRK-PARM-PROCESSED-END-DATE) DTSBE606 00280 GO TO P1100-EXIT. DTSBE606 00281 SKIP3 DTSBE606 00282 MOVE 'N' TO WRK-ASSIGN-TYPE-IND. DTSBE606 00283 DTSBE606 00284 IF WRK-PARM-ASSIGN-TYPE-CNT = +0 DTSBE606 00285 MOVE 'Y' TO WRK-ASSIGN-TYPE-IND DTSBE606 00286 ELSE DTSBE606 00287 PERFORM P1110-CHECK-ASSIGN-TYPE THRU P1110-EXIT DTSBE606 00288 VARYING WRK-PARM-ASSIGN-IDX FROM 1 BY 1 DTSBE606 00289 UNTIL (WRK-ASSIGN-TYPE-IND = 'Y') DTSBE606 00290 OR DTSBE606 00291 (WRK-PARM-ASSIGN-IDX DTSBE606 00292 > WRK-PARM-ASSIGN-TYPE-CNT). DTSBE606 00293 DTSBE606 00294 IF WRK-ASSIGN-TYPE-IND = 'N' DTSBE606 00295 GO TO P1100-EXIT. DTSBE606 00296 SKIP3 DTSBE606 00297 MOVE LOW-VALUES TO MAUR-KEY-AREA. DTSBE606 00298 MOVE MPRF-EMP-NO TO MAUR-EMP-NO. DTSBE606 00299 SET MAUR-AUR-88 TO TRUE. DTSBE606 00300 MOVE MFAS-ASSIGN-NO TO MAUR-ASSIGN-NO. DTSBE606 00301 MOVE MAUR-KEY-AREA TO MSKL-KEY-AREA. DTSBE606 00302 PERFORM S910-READ THRU S910-EXIT. DTSBE606 00303 IF L910-NO-REC-88 DTSBE606 00304 GO TO P1100-EXIT. DTSBE606 00305 MOVE MSKL-REC TO MAUR-REC. DTSBE606 00306 DTSBE606 00307 MOVE MFAS-FLD-REP-ID TO R606-FIELD-REP-ID. DTSBE606 00308 MOVE MFAS-ASSIGN-NO TO R606-ASSIGN-NO. DTSBE606 00309 INITIALIZE R606-DATA-AREA. DTSBE606 00310 MOVE WRK-PARM-AREA TO R606-PARM-AREA. DTSBE606 00311 MOVE MFAS-START-DATE TO R606-START-DATE. DTSBE606 00312 MOVE MFAS-COMPLETED-DATE TO R606-COMPLETED-DATE. DTSBE606 00313 DTSBE606 00314 MOVE MAUR-EMP-SIZE-IND TO R606-EMP-SIZE-IND. DTSBE606 00315 MOVE MAUR-MONEY-DUE-AMT TO R606-MONEY-DUE-AMT. DTSBE606 00316 MOVE MAUR-MONEY-COLLECT-AMT TO R606-MONEY-COLLECT-AMT. DTSBE606 00317 MOVE MAUR-PEN-WAIVE-IND TO R606-PEN-WAIVE-IND. DTSBE606 00318 MOVE MAUR-INT-WAIVE-IND TO R606-INT-WAIVE-IND. DTSBE606 00319 MOVE MAUR-QTRS-AUDITED-CNT TO R606-QTRS-AUDITED-CNT. DTSBE606 00320 MOVE MAUR-AUDIT-HRS TO R606-AUDIT-HRS. DTSBE606 00321 MOVE MAUR-NEW-EMPLOYEE-CNT TO R606-NEW-EMPLOYEE-CNT. DTSBE606 00322 DTSBE606 00323 SET R606-CHANGE-AUDIT-NO-88 TO TRUE. DTSBE606 00324 MOVE LOW-VALUE TO MAUY-KEY-AREA. DTSBE606 00325 MOVE MFAS-EMP-NO TO MAUY-EMP-NO. DTSBE606 00326 SET MAUY-AUY-88 TO TRUE. DTSBE606 00327 MOVE MFAS-ASSIGN-NO TO MAUY-ASSIGN-NO. DTSBE606 00328 MOVE MAUY-KEY-AREA TO MSKL-KEY-AREA. DTSBE606 00329 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE606 00330 IF L910-OK-88 DTSBE606 00331 MOVE MSKL-REC TO MAUY-REC DTSBE606 00332 PERFORM P1120-SCAN-MAUY THRU P1120-EXIT DTSBE606 00333 UNTIL L910-NO-REC-88 DTSBE606 00334 OR MAUY-ASSIGN-NO NOT = MFAS-ASSIGN-NO. DTSBE606 00335 DTSBE606 00336 IF R606-TAX-WAGE-CHANGE = 0 DTSBE606 00337 SET R606-CATEGORY-NOCHANGE-88 TO TRUE DTSBE606 00338 ELSE DTSBE606 00339 IF R606-TAX-WAGE-CHANGE < 0 DTSBE606 00340 SET R606-CATEGORY-DECREASE-88 TO TRUE DTSBE606 00341 ELSE DTSBE606 00342 SET R606-CATEGORY-INCREASE-88 TO TRUE. DTSBE606 00343 SKIP3 DTSBE606 00344 PERFORM S946-WRITE-R606 THRU S946-EXIT. DTSBE606 00345 P1100-EXIT. DTSBE606 00346 EXIT. DTSBE606 00347 EJECT DTSBE606 00348 P1110-CHECK-ASSIGN-TYPE. DTSBE606 00349 IF MFAS-ASSIGN-TYPE DTSBE606 00350 = WRK-PARM-ASSIGN-TYPE (WRK-PARM-ASSIGN-IDX) DTSBE606 00351 MOVE 'Y' TO WRK-ASSIGN-TYPE-IND. DTSBE606 00352 P1110-EXIT. DTSBE606 00353 EXIT. DTSBE606 00354 SKIP3 DTSBE606 00355 P1120-SCAN-MAUY. DTSBE606 00356 PERFORM P1121-SCAN-QTRS THRU P1121-EXIT DTSBE606 00357 VARYING WRK-CNT FROM 1 BY 1 DTSBE606 00358 UNTIL WRK-CNT > MMAX-AUY-QTR-MAX DTSBE606 00359 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE606 00360 MOVE MSKL-REC TO MAUY-REC. DTSBE606 00361 P1120-EXIT. DTSBE606 00362 EXIT. DTSBE606 00363 SKIP3 DTSBE606 00364 P1121-SCAN-QTRS. DTSBE606 00365 ADD MAUY-QTR-GROSS-PAYROLL (WRK-CNT) DTSBE606 00366 TO R606-TOT-GROSS-PAYROLL. DTSBE606 00367 DTSBE606 00368 IF MAUY-QTR-UNDER-TOT-WAGE (WRK-CNT) NOT = 0 DTSBE606 00369 SET R606-CHANGE-AUDIT-YES-88 TO TRUE DTSBE606 00370 ADD MAUY-QTR-UNDER-TOT-WAGE (WRK-CNT) DTSBE606 00371 TO R606-TOT-WAGE-CHANGE. DTSBE606 00372 IF MAUY-QTR-UNDER-TAX-WAGE (WRK-CNT) NOT = 0 DTSBE606 00373 SET R606-CHANGE-AUDIT-YES-88 TO TRUE DTSBE606 00374 ADD MAUY-QTR-UNDER-TAX-WAGE (WRK-CNT) DTSBE606 00375 TO R606-TAX-WAGE-CHANGE. DTSBE606 00376 IF MAUY-QTR-UNDER-CONTRIB (WRK-CNT) NOT = 0 DTSBE606 00377 SET R606-CHANGE-AUDIT-YES-88 TO TRUE DTSBE606 00378 ADD MAUY-QTR-UNDER-CONTRIB (WRK-CNT) DTSBE606 00379 TO R606-CONTRIB-CHANGE. DTSBE606 00380 DTSBE606 00381 IF MAUY-QTR-OVER-TOT-WAGE (WRK-CNT) NOT = 0 DTSBE606 00382 SET R606-CHANGE-AUDIT-YES-88 TO TRUE DTSBE606 00383 SUBTRACT MAUY-QTR-OVER-TOT-WAGE (WRK-CNT) DTSBE606 00384 FROM R606-TOT-WAGE-CHANGE. DTSBE606 00385 IF MAUY-QTR-OVER-TAX-WAGE (WRK-CNT) NOT = 0 DTSBE606 00386 SET R606-CHANGE-AUDIT-YES-88 TO TRUE DTSBE606 00387 SUBTRACT MAUY-QTR-OVER-TAX-WAGE (WRK-CNT) DTSBE606 00388 FROM R606-TAX-WAGE-CHANGE. DTSBE606 00389 IF MAUY-QTR-OVER-CONTRIB (WRK-CNT) NOT = 0 DTSBE606 00390 SET R606-CHANGE-AUDIT-YES-88 TO TRUE DTSBE606 00391 SUBTRACT MAUY-QTR-OVER-CONTRIB (WRK-CNT) DTSBE606 00392 FROM R606-CONTRIB-CHANGE. DTSBE606 00393 P1121-EXIT. DTSBE606 00394 EXIT. DTSBE606 00395 EJECT DTSBE606 00396 S001-FROM-CAL-6. DTSBE606 00397 SET L001-FROM-CAL-6 TO TRUE. DTSBE606 00398 GO TO S001-DATE. DTSBE606 00399 SKIP1 DTSBE606 00400 S001-DATE. DTSBE606 00401 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE606 00402 S001-EXIT. DTSBE606 00403 EXIT. DTSBE606 00404 SKIP3 DTSBE606 00405 S910-READ. DTSBE606 00406 SET L910-READ-88 TO TRUE. DTSBE606 00407 GO TO S910-MSTR-IO. DTSBE606 00408 SKIP1 DTSBE606 00409 S910-START-BROWSE. DTSBE606 00410 SET L910-START-BROWSE-88 TO TRUE. DTSBE606 00411 GO TO S910-MSTR-IO. DTSBE606 00412 SKIP1 DTSBE606 00413 S910-READ-NEXT. DTSBE606 00414 SET L910-READ-NEXT-88 TO TRUE. DTSBE606 00415 GO TO S910-MSTR-IO. DTSBE606 00416 SKIP1 DTSBE606 00417 *S910-COUNT. DTSBE606 00418 * SET L910-COUNT-88 TO TRUE. DTSBE606 00419 * GO TO S910-MSTR-IO. DTSBE606 00420 SKIP1 DTSBE606 00421 S910-MSTR-IO. DTSBE606 00422 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE606 00423 MSKL-REC. DTSBE606 00424 S910-EXIT. DTSBE606 00425 EXIT. DTSBE606 00426 SKIP3 DTSBE606 00427 S946-WRITE-R606. DTSBE606 00428 CALL 'DTSBU946' USING R606-REC. DTSBE606 00429 S946-EXIT. DTSBE606 00430 EXIT. DTSBE606 00431 SKIP3 DTSBE606 00432 S999-ABEND. DTSBE606 00433 DISPLAY '*** DTSBE606 ABENDING. ' ABEND-MSG. DTSBE606 00434 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE606 00435 S999-EXIT. DTSBE606 00436 EXIT. DTSBE606 00437 EJECT DTSBE606 00438 T0000-TERMINATE. DTSBE606 00439 DTSBE606 00440 CONTINUE. DTSBE606 00441 DTSBE606 00442 T0000-EXIT. DTSBE606 00443 EXIT. DTSBE606