00001 IDENTIFICATION DIVISION. 01/18/04 00002 PROGRAM-ID. DTSBU549. DTSBU549 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009 00004 DATE-WRITTEN. JANUARY 1991. DTSBU549 00005 DATE-COMPILED. DTSBU549 00006 SKIP3 DTSBU549 00007 ***** DTSBU549 00008 * DTSBU549 00009 * FUNCTION: JOURNALING/BATCH DETAIL LISTING. DTSBU549 00010 * DTSBU549 00011 * DTSBU549 00012 * MODIFICATION LOG: DTSBU549 00013 * DTSBU549 00014 * 01/26/92 INITIAL DEVELOPMENT. DTSBU549 00015 * WORK ORDER: PROGRAMMER: TCL DTSBU549 00016 * DTSBU549 00017 * 12/13/1998 REVIEWED AND MODIFIED FOR DC. DTSBU549 00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBU549 00019 * DTSBU549 00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU549 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU549 00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU549 00023 * DTSBU549 00024 * DTSBU549 00025 * DESCRIPTION: DTSBU549 00026 * DTSBU549 00027 * FOR A GIVEN ACCOUNTING TRANSACTION DTSBU549 IS CALLED: DTSBU549 00028 * DTSBU549 00029 * A. ONE TIME WITH L549-INIT-TRAN-88. DTSBU549 00030 * DTSBU549 00031 * B. ZERO, ONE, OR MANY TIMES WITH L549-DELTA-88. DTSBU549 00032 * DTSBU549 00033 * C. ONE TIME WITH L549-CANCEL-TRAN-88 DTSBU549 00034 * OR L549-TERM-TRAN-88. DTSBU549 00035 * DTSBU549 00036 * DTSBU549 SHOULD BE CONSTRUCTED TO PROCESS TWO TRANSACTIONS DTSBU549 00037 * AT THE SAME TIME. THIS WILL PROBABLY NOT BE NECESSARY, DTSBU549 00038 * BUT WILL BE REQUIRED IF AN ACCOUNTING TRANSACTION CAN DTSBU549 00039 * GENERATE AN INTERNAL ACCOUNTING TRANSACTION. DTSBU549 00040 * DTSBU549 00041 * IF L549-INIT-TRAN-88, THEN HOLD L549-INIT-AREA IN WORKING DTSBU549 00042 * STORAGE AND INITIALIZE A TABLE TO HOLD THE CHANGES TO DTSBU549 00043 * ACCOUNTING AMOUNTS. DTSBU549 00044 * DTSBU549 00045 * IF L549-DELTA-88, THEN DTSBU549 IS BEING ASKED TO TABLE DTSBU549 00046 * A CHANGE TO AN ACCOUNTING AMOUNT. IF THERE IS NO ROOM IN DTSBU549 00047 * THE TABLE FOR THE AMOUNT, THEN WRITE A MJRN RECORD AND DTSBU549 00048 * WRITE A R302 RECORD (MAKE THE NUMBER OF OCCURRENCES IN DTSBU549 00049 * THE TABLE BIG ENOUGH TO MAKE THIS EVENT RARE). TABLING DTSBU549 00050 * CHANGES TO ACCOUNTING AMOUNTS (BASED ON L549-DELTA-KEY) DTSBU549 00051 * WILL ALLOW US TO MINIMIZE THE NUMBER OF MJRN AND R302 DTSBU549 00052 * RECORDS WRITTEN. DTSBU549 00053 * DTSBU549 00054 * IF L549-CANCEL-TRAN-88 DTSBU549 00055 * IF NO INFORMATION TABLED DTSBU549 00056 * CANCEL THE TRANSACTION WITHOUT WRITING ANY RECORDS DTSBU549 00057 * ELSE DTSBU549 00058 * ABEND THE MODULE. DTSBU549 00059 * DTSBU549 00060 * IF L549-TERM-TRN-88 DTSBU549 00061 * WRITE AN R302-TRAN-INFO RECORD DTSBU549 00062 * IF INFORMATION TABLED DTSBU549 00063 * FOR EACH NON ZERO TABLE ENTRY, WRITE A R302-ACCT-INFO DTSBU549 00064 * RECORD; WRITE ONE TO TEN MJRN RECORDS. DTSBU549 00065 * DTSBU549 00066 * DTSBU549 00067 * MASTER FILE RECORDS READ: DTSBU549 00068 * DTSBU549 00069 * NONE DTSBU549 00070 * DTSBU549 00071 * DTSBU549 00072 * MASTER FILE RECORDS UPDATED: DTSBU549 00073 * DTSBU549 00074 * MJRN (WRITE) DTSBU549 00075 * DTSBU549 00076 * DTSBU549 00077 * REPORT RECORDS WRITTEN: DTSBU549 00078 * DTSBU549 00079 * R302 BATCH DETAIL. DTSBU549 00080 * DTSBU549 00081 * DTSBU549 00082 * MODULES CALLED: DTSBU549 00083 * DTSBU549 00084 * DTSBU910 MASTER FILE I/O. DTSBU549 00085 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBU549 00086 * DTSBU549 00087 * DTSBU549 00088 ***** DTSBU549 00089 SKIP3 DTSBU549 00090 ENVIRONMENT DIVISION. DTSBU549 00091 EJECT DTSBU549 00092 DATA DIVISION. DTSBU549 00093 SKIP3 DTSBU549 00094 WORKING-STORAGE SECTION. DTSBU549 000945 77 PAN-VALET PICTURE X(24) VALUE '009DTSBU549 01/18/04'. DTSBU549 00095 SKIP3 DTSBU549 00096 01 WRK-AREA. DTSBU549 00097 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +549.DTSBU549 00098 DTSBU549 00099 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU549'.DTSBU549 00100 DTSBU549 00101 05 MAX-DET-CNT PIC S9(04) COMP VALUE +1000.DTSBU549 00102 DTSBU549 00103 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSBU549 00104 VALUE +99999. DTSBU549 00105 DTSBU549 00106 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU549 00107 DTSBU549 00108 05 WRK-MJRN-FOUND-KEY PIC X(16). DTSBU549 00109 DTSBU549 00110 05 WRK-START-ABSTIME PIC S9(15) COMP-3. DTSBU549 00111 DTSBU549 00112 05 WRK-ABSTIME PIC S9(15) COMP-3. DTSBU549 00113 DTSBU549 00114 05 WRK-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBU549 00115 DTSBU549 00116 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBU549 00117 DTSBU549 00118 05 WRK-DET-SUB PIC S9(04) COMP. DTSBU549 00119 DTSBU549 00120 05 WRK-CREDIT-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSBU549 00121 DTSBU549 00122 05 WRK-TRN. DTSBU549 00123 10 WRK-DOC-NO PIC X(05). DTSBU549 00124 10 FILLER REDEFINES WRK-DOC-NO. DTSBU549 00125 15 WRK-BATCH-NO PIC S9(05) COMP-3. DTSBU549 00126 15 WRK-ITEM-NO PIC S9(03) COMP-3. DTSBU549 00127 10 WRK-EMP-CLASS PIC X(01). DTSBU549 00128 10 WRK-EMP-ELIGIBLE-CD PIC S9(03) COMP-3. DTSBU549 00129 10 WRK-REC-TYPE PIC X(01). DTSBU549 00130 10 WRK-TRANS-TYPE PIC X(02). DTSBU549 00131 10 WRK-RECEIVED-DATE PIC S9(09) COMP-3. DTSBU549 00132 10 WRK-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBU549 00133 10 WRK-REMIT-AMT PIC S9(09)V9(02) COMP-3. DTSBU549 00134 10 WRK-WAIVE-INT-IND PIC X(01). DTSBU549 00135 10 WRK-WAIVE-LATE-PEN-IND PIC X(01). DTSBU549 00136 10 WRK-APPLIC-YRQ PIC S9(05) COMP-3. DTSBU549 00137 10 WRK-APPLIC-ACCT-IND PIC X(02). DTSBU549 00138 10 WRK-APPLIC-DOC-NO PIC X(05). DTSBU549 00139 10 WRK-RESP-ACTIVITY PIC X(03). DTSBU549 00140 10 WRK-RESP-OP-ID PIC X(08). DTSBU549 00141 10 WRK-TOT-WAGE-CHNG PIC S9(11)V9(02) COMP-3. DTSBU549 00142 10 WRK-TAX-WAGE-CHNG PIC S9(11)V9(02) COMP-3. DTSBU549 00143 DTSBU549 00144 10 WRK-MJRN-CNT PIC S9(04) COMP. DTSBU549 00145 DTSBU549 00146 10 WRK-R302-CNT PIC S9(04) COMP. DTSBU549 00147 DTSBU549 00148 10 WRK-DET-CNT PIC S9(04) COMP. DTSBU549 00149 DTSBU549 00150 10 WRK-DETAIL OCCURS 1000 TIMES DTSBU549 00151 INDEXED BY WRK-DET-IDX. DTSBU549 00152 15 WRK-DET-KEY. DTSBU549 00153 20 WRK-DET-YRQ PIC S9(05) COMP-3. DTSBU549 00154 20 WRK-DET-ACCT-IND PIC X(02). DTSBU549 00155 15 WRK-DET-DATA. DTSBU549 00156 20 WRK-DET-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBU549 00157 20 WRK-DET-PAID-AMT PIC S9(09)V9(02) COMP-3. DTSBU549 00158 20 WRK-DET-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBU549 00159 20 WRK-DET-WRITTEN-OFF-AMT DTSBU549 00160 PIC S9(09)V9(02) COMP-3. DTSBU549 00161 20 WRK-DET-TOLER-AMT PIC S9(09)V9(02) COMP-3. DTSBU549 00162 SKIP3 DTSBU549 00163 01 TBL-AREA. DTSBU549 00164 05 TBL-TRN OCCURS 2 TIMES. DTSBU549 00165 10 TBL-DOC-NO PIC X(05). DTSBU549 00166 88 TBL-EMPTY-88 VALUE LOW-VALUES. DTSBU549 00167 10 FILLER PIC X(40000). DTSBU549 00168 EJECT DTSBU549 00169 01 R302-REC. DTSBU549 00170 ++INCLUDE DTSIR302 DTSBU549 00171 EJECT DTSBU549 00172 01 L910-LINK-AREA. DTSBU549 00173 ++INCLUDE DTSIL910 DTSBU549 00174 SKIP3 DTSBU549 00175 01 MSKL-REC. DTSBU549 00176 ++INCLUDE DTSIMSKL DTSBU549 00177 SKIP3 DTSBU549 00178 01 MJRN-REC. DTSBU549 00179 ++INCLUDE DTSIMJRN DTSBU549 00180 EJECT DTSBU549 00181 01 CACT-LITERALS. DTSBU549 00182 ++INCLUDE DTSICACT DTSBU549 00183 SKIP3 DTSBU549 00184 01 MMAX-LITERALS. DTSBU549 00185 ++INCLUDE DTSIMMAX DTSBU549 00186 EJECT DTSBU549 00187 LINKAGE SECTION. DTSBU549 00188 SKIP3 DTSBU549 00189 01 L549-LINK-AREA. DTSBU549 00190 ++INCLUDE DTSIL549 DTSBU549 00191 EJECT DTSBU549 00192 PROCEDURE DIVISION USING L549-LINK-AREA. DTSBU549 00193 DTSBU549 00194 DTSBU549 00195 IF FIRST-TIME-IND = 'Y' DTSBU549 00196 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBU549 00197 MOVE 'N' TO FIRST-TIME-IND. DTSBU549 00198 DTSBU549 00199 DTSBU549 00200 IF L549-INIT-TRAN-88 DTSBU549 00201 PERFORM P1000-INIT-TRAN THRU P1000-EXIT DTSBU549 00202 ELSE DTSBU549 00203 IF L549-DELTA-88 DTSBU549 00204 PERFORM P2000-DELTA THRU P2000-EXIT DTSBU549 00205 ELSE DTSBU549 00206 IF L549-CANCEL-TRAN-88 DTSBU549 00207 PERFORM P3000-CANCEL-TRAN THRU P3000-EXIT DTSBU549 00208 ELSE DTSBU549 00209 IF L549-TERM-TRAN-PRIM-88 DTSBU549 00210 PERFORM P4000-TERM-TRAN-PRIM THRU P4000-EXIT DTSBU549 00211 ELSE DTSBU549 00212 IF L549-TERM-TRAN-SEC-88 DTSBU549 00213 PERFORM P5000-TERM-TRAN-SEC THRU P5000-EXIT DTSBU549 00214 ELSE DTSBU549 00215 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00216 DTSBU549 00217 DTSBU549 00218 GOBACK. DTSBU549 00219 EJECT DTSBU549 00220 I0000-INITIATE. DTSBU549 00221 MOVE L549-INIT-ABSTIME TO WRK-START-ABSTIME DTSBU549 00222 WRK-ABSTIME. DTSBU549 00223 DTSBU549 00224 MOVE L549-INIT-CURR-RUN-DATE TO WRK-CURR-RUN-DATE. DTSBU549 00225 DTSBU549 00226 MOVE -1 TO WRK-EMP-NO. DTSBU549 00227 DTSBU549 00228 MOVE LOW-VALUES TO TBL-DOC-NO (1) DTSBU549 00229 TBL-DOC-NO (2). DTSBU549 00230 DTSBU549 00231 MOVE L549-INIT-TRACE-IND TO L910-TRACE-IND. DTSBU549 00232 DTSBU549 00233 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBU549 00234 DTSBU549 00235 MOVE LENGTH OF R302-REC TO R302-LENGTH. DTSBU549 00236 I0000-EXIT. DTSBU549 00237 EXIT. DTSBU549 00238 EJECT DTSBU549 00239 P0000-EMP-NO-BREAK. DTSBU549 00240 IF (TBL-EMPTY-88 (1)) AND (TBL-EMPTY-88 (2)) DTSBU549 00241 NEXT SENTENCE DTSBU549 00242 ELSE DTSBU549 00243 DISPLAY 'BU549 ABEND P0000 ' L549-INIT-EMP-NO DTSBU549 00244 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00245 DTSBU549 00246 MOVE WRK-START-ABSTIME TO WRK-ABSTIME. DTSBU549 00247 P0000-EXIT. DTSBU549 00248 EXIT. DTSBU549 00249 EJECT DTSBU549 00250 P1000-INIT-TRAN. DTSBU549 00251 IF L549-INIT-EMP-NO NOT = WRK-EMP-NO DTSBU549 00252 PERFORM P0000-EMP-NO-BREAK THRU P0000-EXIT DTSBU549 00253 MOVE L549-INIT-EMP-NO TO WRK-EMP-NO. DTSBU549 00254 DTSBU549 00255 PERFORM P1100-INIT-WRK THRU P1100-EXIT. DTSBU549 00256 DTSBU549 00257 IF TBL-EMPTY-88 (1) DTSBU549 00258 MOVE WRK-TRN TO TBL-TRN (1) DTSBU549 00259 ELSE DTSBU549 00260 IF TBL-EMPTY-88 (2) DTSBU549 00261 MOVE WRK-TRN TO TBL-TRN (2) DTSBU549 00262 ELSE DTSBU549 00263 DISPLAY 'BU549 ABEND P1000 ' L549-INIT-EMP-NO DTSBU549 00264 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00265 P1000-EXIT. DTSBU549 00266 EXIT. DTSBU549 00267 EJECT DTSBU549 00268 P1100-INIT-WRK. DTSBU549 00269 MOVE L549-TRN-DOC-NO TO WRK-DOC-NO. DTSBU549 00270 DTSBU549 00271 MOVE L549-INIT-EMP-CLASS TO WRK-EMP-CLASS. DTSBU549 00272 DTSBU549 00273 MOVE L549-INIT-ELIGIBLE-CD TO WRK-EMP-ELIGIBLE-CD. DTSBU549 00274 DTSBU549 00275 MOVE L549-INIT-REC-TYPE TO WRK-REC-TYPE. DTSBU549 00276 DTSBU549 00277 MOVE L549-INIT-TRANS-TYPE TO WRK-TRANS-TYPE. DTSBU549 00278 DTSBU549 00279 MOVE L549-INIT-RECEIVED-DATE TO WRK-RECEIVED-DATE. DTSBU549 00280 DTSBU549 00281 MOVE L549-INIT-DEPOSIT-DATE TO WRK-DEPOSIT-DATE. DTSBU549 00282 DTSBU549 00283 MOVE L549-INIT-REMIT-AMT TO WRK-REMIT-AMT. DTSBU549 00284 DTSBU549 00285 MOVE L549-INIT-WAIVE-INT-IND TO WRK-WAIVE-INT-IND. DTSBU549 00286 DTSBU549 00287 MOVE L549-INIT-WAIVE-LATE-PEN-IND TO WRK-WAIVE-LATE-PEN-IND. DTSBU549 00288 DTSBU549 00289 MOVE L549-INIT-APPLIC-YRQ TO WRK-APPLIC-YRQ. DTSBU549 00290 DTSBU549 00291 MOVE L549-INIT-APPLIC-ACCT-IND TO WRK-APPLIC-ACCT-IND. DTSBU549 00292 DTSBU549 00293 MOVE L549-INIT-APPLIC-DOC-NO TO WRK-APPLIC-DOC-NO. DTSBU549 00294 DTSBU549 00295 MOVE L549-INIT-RESP-ACTIVITY TO WRK-RESP-ACTIVITY. DTSBU549 00296 DTSBU549 00297 MOVE L549-INIT-RESP-OP-ID TO WRK-RESP-OP-ID. DTSBU549 00298 DTSBU549 00299 MOVE +0 TO WRK-TOT-WAGE-CHNG DTSBU549 00300 WRK-TAX-WAGE-CHNG. DTSBU549 00301 DTSBU549 00302 MOVE +0 TO WRK-R302-CNT DTSBU549 00303 WRK-DET-CNT DTSBU549 00304 WRK-MJRN-CNT. DTSBU549 00305 P1100-EXIT. DTSBU549 00306 EXIT. DTSBU549 00307 EJECT DTSBU549 00308 P2000-DELTA. DTSBU549 00309 IF L549-TRN-DOC-NO = TBL-DOC-NO (1) DTSBU549 00310 MOVE TBL-TRN (1) TO WRK-TRN DTSBU549 00311 PERFORM P2100-UPDATE-WRK THRU P2100-EXIT DTSBU549 00312 MOVE WRK-TRN TO TBL-TRN (1) DTSBU549 00313 ELSE DTSBU549 00314 IF L549-TRN-DOC-NO = TBL-DOC-NO (2) DTSBU549 00315 MOVE TBL-TRN (2) TO WRK-TRN DTSBU549 00316 PERFORM P2100-UPDATE-WRK THRU P2100-EXIT DTSBU549 00317 MOVE WRK-TRN TO TBL-TRN (2) DTSBU549 00318 ELSE DTSBU549 00319 DISPLAY 'BU549 ABEND P2000 ' L549-INIT-EMP-NO DTSBU549 00320 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00321 P2000-EXIT. DTSBU549 00322 EXIT. DTSBU549 00323 SKIP3 DTSBU549 00324 P2100-UPDATE-WRK. DTSBU549 00325 IF L549-DELTA-ACCT-IND = CACT-ACCT-WAGE DTSBU549 00326 PERFORM P2130-WAGE THRU P2130-EXIT DTSBU549 00327 GO TO P2100-EXIT. DTSBU549 00328 DTSBU549 00329 DTSBU549 00330 MOVE +0 TO WRK-DET-SUB. DTSBU549 00331 DTSBU549 00332 PERFORM P2110-LOCATE-DET-KEY THRU P2110-EXIT DTSBU549 00333 VARYING WRK-DET-IDX FROM 1 BY 1 DTSBU549 00334 UNTIL (WRK-DET-IDX > WRK-DET-CNT) DTSBU549 00335 OR DTSBU549 00336 (WRK-DET-SUB NOT = 0). DTSBU549 00337 DTSBU549 00338 IF WRK-DET-SUB = 0 DTSBU549 00339 PERFORM P2120-INIT-DET-KEY THRU P2120-EXIT. DTSBU549 00340 DTSBU549 00341 IF L549-DELTA-CAT-IND = CACT-CAT-CHARGED DTSBU549 00342 ADD L549-DELTA-AMT TO WRK-DET-CHARGED-AMT (WRK-DET-SUB) DTSBU549 00343 ELSE DTSBU549 00344 IF L549-DELTA-CAT-IND = CACT-CAT-PAID DTSBU549 00345 ADD L549-DELTA-AMT TO WRK-DET-PAID-AMT (WRK-DET-SUB) DTSBU549 00346 ELSE DTSBU549 00347 IF L549-DELTA-CAT-IND = CACT-CAT-WAIVED DTSBU549 00348 ADD L549-DELTA-AMT TO WRK-DET-WAIVED-AMT (WRK-DET-SUB) DTSBU549 00349 ELSE DTSBU549 00350 IF L549-DELTA-CAT-IND = CACT-CAT-WRITTEN-OFF DTSBU549 00351 ADD L549-DELTA-AMT DTSBU549 00352 TO WRK-DET-WRITTEN-OFF-AMT (WRK-DET-SUB) DTSBU549 00353 ELSE DTSBU549 00354 IF L549-DELTA-CAT-IND = CACT-CAT-TOLER DTSBU549 00355 ADD L549-DELTA-AMT TO WRK-DET-TOLER-AMT (WRK-DET-SUB) DTSBU549 00356 ELSE DTSBU549 00357 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00358 P2100-EXIT. DTSBU549 00359 EXIT. DTSBU549 00360 SKIP3 DTSBU549 00361 P2110-LOCATE-DET-KEY. DTSBU549 00362 IF L549-DELTA-KEY = WRK-DET-KEY (WRK-DET-IDX) DTSBU549 00363 SET WRK-DET-SUB TO WRK-DET-IDX. DTSBU549 00364 P2110-EXIT. DTSBU549 00365 EXIT. DTSBU549 00366 SKIP3 DTSBU549 00367 P2120-INIT-DET-KEY. DTSBU549 00368 IF WRK-DET-CNT < MAX-DET-CNT DTSBU549 00369 NEXT SENTENCE DTSBU549 00370 ELSE DTSBU549 00371 DISPLAY '*** DTSBU549 WRK-DETAIL MAX OCCURENCES ' DTSBU549 00372 'EXCEEDED.' DTSBU549 00373 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00374 DTSBU549 00375 DTSBU549 00376 ADD +1 TO WRK-DET-CNT. DTSBU549 00377 DTSBU549 00378 MOVE L549-DELTA-KEY TO WRK-DET-KEY (WRK-DET-CNT). DTSBU549 00379 DTSBU549 00380 MOVE +0 TO WRK-DET-CHARGED-AMT (WRK-DET-CNT) DTSBU549 00381 WRK-DET-PAID-AMT (WRK-DET-CNT) DTSBU549 00382 WRK-DET-WAIVED-AMT (WRK-DET-CNT) DTSBU549 00383 WRK-DET-WRITTEN-OFF-AMT (WRK-DET-CNT) DTSBU549 00384 WRK-DET-TOLER-AMT (WRK-DET-CNT). DTSBU549 00385 DTSBU549 00386 MOVE WRK-DET-CNT TO WRK-DET-SUB. DTSBU549 00387 P2120-EXIT. DTSBU549 00388 EXIT. DTSBU549 00389 SKIP3 DTSBU549 00390 P2130-WAGE. DTSBU549 00391 IF L549-DELTA-YRQ = WRK-APPLIC-YRQ DTSBU549 00392 NEXT SENTENCE DTSBU549 00393 ELSE DTSBU549 00394 DISPLAY 'BU549 ABEND P2130 - 1 ' L549-INIT-EMP-NO DTSBU549 00395 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00396 DTSBU549 00397 IF L549-DELTA-CAT-IND = CACT-CAT-TOT-WAGE DTSBU549 00398 ADD L549-DELTA-AMT TO WRK-TOT-WAGE-CHNG DTSBU549 00399 ELSE DTSBU549 00400 IF L549-DELTA-CAT-IND = CACT-CAT-TAX-WAGE DTSBU549 00401 ADD L549-DELTA-AMT TO WRK-TAX-WAGE-CHNG DTSBU549 00402 ELSE DTSBU549 00403 DISPLAY 'BU549 ABEND P2130 - 2 ' L549-INIT-EMP-NO DTSBU549 00404 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00405 P2130-EXIT. DTSBU549 00406 EXIT. DTSBU549 00407 EJECT DTSBU549 00408 P3000-CANCEL-TRAN. DTSBU549 00409 IF L549-TRN-DOC-NO = TBL-DOC-NO (1) DTSBU549 00410 MOVE TBL-TRN (1) TO WRK-TRN DTSBU549 00411 PERFORM P3100-CANCEL-WRK THRU P3100-EXIT DTSBU549 00412 MOVE WRK-TRN TO TBL-TRN (1) DTSBU549 00413 ELSE DTSBU549 00414 IF L549-TRN-DOC-NO = TBL-DOC-NO (2) DTSBU549 00415 MOVE TBL-TRN (2) TO WRK-TRN DTSBU549 00416 PERFORM P3100-CANCEL-WRK THRU P3100-EXIT DTSBU549 00417 MOVE WRK-TRN TO TBL-TRN (2) DTSBU549 00418 ELSE DTSBU549 00419 DISPLAY 'BU549 ABEND P3000 ' L549-INIT-EMP-NO DTSBU549 00420 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00421 P3000-EXIT. DTSBU549 00422 EXIT. DTSBU549 00423 SKIP3 DTSBU549 00424 P3100-CANCEL-WRK. DTSBU549 00425 IF WRK-DET-CNT = 0 DTSBU549 00426 MOVE LOW-VALUES TO WRK-DOC-NO DTSBU549 00427 ELSE DTSBU549 00428 DISPLAY 'BU549 ABEND P3100 ' L549-INIT-EMP-NO DTSBU549 00429 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00430 P3100-EXIT. DTSBU549 00431 EXIT. DTSBU549 00432 EJECT DTSBU549 00433 P4000-TERM-TRAN-PRIM. DTSBU549 00434 IF L549-TRN-DOC-NO = TBL-DOC-NO (1) DTSBU549 00435 MOVE TBL-TRN (1) TO WRK-TRN DTSBU549 00436 PERFORM P4100-TERM-PRIM-WRK THRU P4100-EXIT DTSBU549 00437 MOVE WRK-TRN TO TBL-TRN (1) DTSBU549 00438 ELSE DTSBU549 00439 IF L549-TRN-DOC-NO = TBL-DOC-NO (2) DTSBU549 00440 MOVE TBL-TRN (2) TO WRK-TRN DTSBU549 00441 PERFORM P4100-TERM-PRIM-WRK THRU P4100-EXIT DTSBU549 00442 MOVE WRK-TRN TO TBL-TRN (2) DTSBU549 00443 ELSE DTSBU549 00444 DISPLAY 'BU549 ABEND P4000 ' L549-INIT-EMP-NO DTSBU549 00445 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00446 P4000-EXIT. DTSBU549 00447 EXIT. DTSBU549 00448 SKIP3 DTSBU549 00449 P4100-TERM-PRIM-WRK. DTSBU549 00450 ADD +100 TO WRK-ABSTIME. DTSBU549 00451 DTSBU549 00452 PERFORM S1100-INIT-MJRN THRU S1100-EXIT. DTSBU549 00453 DTSBU549 00454 PERFORM S1200-INIT-R302-TRAN-DATA THRU S1200-EXIT. DTSBU549 00455 DTSBU549 00456 PERFORM S9200-R302-WRITE THRU S9200-EXIT. DTSBU549 00457 DTSBU549 00458 SET R302-ACCT-DATA-88 TO TRUE. DTSBU549 00459 DTSBU549 00460 MOVE LOW-VALUES TO R302-TRAN-DATA-AREA. DTSBU549 00461 DTSBU549 00462 PERFORM S2100-WRK-DET-PROCESS THRU S2100-EXIT DTSBU549 00463 VARYING WRK-DET-IDX FROM 1 BY 1 DTSBU549 00464 UNTIL WRK-DET-IDX > WRK-DET-CNT. DTSBU549 00465 DTSBU549 00466 IF MJRN-OCC-CNT > +0 DTSBU549 00467 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00468 DTSBU549 00469 *****IF WRK-R302-CNT = +0 DTSBU549 00470 *********MOVE +0 TO R302-SORT-YRQ DTSBU549 00471 ********************R302-SORT-ACCT-SEQ DTSBU549 00472 *********MOVE SPACE TO R302-SORT-ACCT-IND DTSBU549 00473 *********MOVE +0 TO R302-YRQ DTSBU549 00474 *********MOVE SPACE TO R302-ACCT-IND DTSBU549 00475 *********MOVE +0 TO R302-CHARGED-AMT DTSBU549 00476 ********************R302-PAID-AMT DTSBU549 00477 ********************R302-WAIVED-AMT DTSBU549 00478 ********************R302-WRITTEN-OFF-AMT DTSBU549 00479 ********************R302-TOLER-AMT DTSBU549 00480 *********PERFORM S9200-R302-WRITE THRU S9200-EXIT. DTSBU549 00481 DTSBU549 00482 MOVE LOW-VALUES TO WRK-DOC-NO. DTSBU549 00483 P4100-EXIT. DTSBU549 00484 EXIT. DTSBU549 00485 EJECT DTSBU549 00486 P5000-TERM-TRAN-SEC. DTSBU549 00487 IF L549-TRN-DOC-NO = TBL-DOC-NO (1) DTSBU549 00488 MOVE TBL-TRN (1) TO WRK-TRN DTSBU549 00489 PERFORM P5100-TERM-SEC-WRK THRU P5100-EXIT DTSBU549 00490 MOVE WRK-TRN TO TBL-TRN (1) DTSBU549 00491 ELSE DTSBU549 00492 IF L549-TRN-DOC-NO = TBL-DOC-NO (2) DTSBU549 00493 MOVE TBL-TRN (2) TO WRK-TRN DTSBU549 00494 PERFORM P5100-TERM-SEC-WRK THRU P5100-EXIT DTSBU549 00495 MOVE WRK-TRN TO TBL-TRN (2) DTSBU549 00496 ELSE DTSBU549 00497 DISPLAY 'BU549 ABEND P5000 ' L549-INIT-EMP-NO DTSBU549 00498 PERFORM S999-ABEND THRU S999-EXIT. DTSBU549 00499 P5000-EXIT. DTSBU549 00500 EXIT. DTSBU549 00501 SKIP3 DTSBU549 00502 P5100-TERM-SEC-WRK. DTSBU549 00503 PERFORM P5110-PREPARE-MJRN THRU P5110-EXIT. DTSBU549 00504 DTSBU549 00505 MOVE WRK-DEPOSIT-DATE TO R302-DEPOSIT-DATE. DTSBU549 00506 DTSBU549 00507 MOVE WRK-BATCH-NO TO R302-BATCH-NO. DTSBU549 00508 DTSBU549 00509 MOVE WRK-EMP-NO TO R302-EMP-NO. DTSBU549 00510 DTSBU549 00511 MOVE WRK-ITEM-NO TO R302-ITEM-NO. DTSBU549 00512 DTSBU549 00513 SET R302-ACCT-DATA-88 TO TRUE. DTSBU549 00514 DTSBU549 00515 MOVE +0 TO R302-SORT-YRQ DTSBU549 00516 R302-SORT-ACCT-SEQ. DTSBU549 00517 DTSBU549 00518 MOVE SPACES TO R302-SORT-ACCT-IND. DTSBU549 00519 DTSBU549 00520 MOVE LOW-VALUES TO R302-TRAN-DATA-AREA. DTSBU549 00521 DTSBU549 00522 PERFORM S2100-WRK-DET-PROCESS THRU S2100-EXIT DTSBU549 00523 VARYING WRK-DET-IDX FROM 1 BY 1 DTSBU549 00524 UNTIL WRK-DET-IDX > WRK-DET-CNT. DTSBU549 00525 DTSBU549 00526 IF MJRN-OCC-CNT > +0 DTSBU549 00527 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00528 DTSBU549 00529 MOVE LOW-VALUES TO WRK-DOC-NO. DTSBU549 00530 P5100-EXIT. DTSBU549 00531 EXIT. DTSBU549 00532 SKIP3 DTSBU549 00533 P5110-PREPARE-MJRN. DTSBU549 00534 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBU549 00535 DTSBU549 00536 MOVE WRK-EMP-NO TO MJRN-EMP-NO. DTSBU549 00537 DTSBU549 00538 SET MJRN-JRN-88 TO TRUE. DTSBU549 00539 DTSBU549 00540 MOVE WRK-START-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBU549 00541 DTSBU549 00542 MOVE LOW-VALUES TO WRK-MJRN-FOUND-KEY. DTSBU549 00543 DTSBU549 00544 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBU549 00545 DTSBU549 00546 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBU549 00547 DTSBU549 00548 PERFORM P5111-SCAN-MJRN THRU P5111-EXIT DTSBU549 00549 UNTIL L910-NO-REC-88. DTSBU549 00550 DTSBU549 00551 IF WRK-MJRN-FOUND-KEY = LOW-VALUES DTSBU549 00552 ADD +100 TO WRK-ABSTIME DTSBU549 00553 PERFORM S1100-INIT-MJRN THRU S1100-EXIT DTSBU549 00554 ELSE DTSBU549 00555 MOVE WRK-MJRN-FOUND-KEY TO MSKL-KEY-AREA DTSBU549 00556 PERFORM S910-READ THRU S910-EXIT DTSBU549 00557 IF L910-NO-REC-88 DTSBU549 00558 DISPLAY 'BU549 ABEND P5110 ' L549-INIT-EMP-NO DTSBU549 00559 PERFORM S999-ABEND THRU S999-EXIT DTSBU549 00560 END-IF DTSBU549 00561 MOVE MSKL-REC TO MJRN-REC DTSBU549 00562 PERFORM S910-DELETE THRU S910-EXIT. DTSBU549 00563 P5110-EXIT. DTSBU549 00564 EXIT. DTSBU549 00565 SKIP3 DTSBU549 00566 P5111-SCAN-MJRN. DTSBU549 00567 MOVE MSKL-REC TO MJRN-REC. DTSBU549 00568 DTSBU549 00569 IF MJRN-DOC-NO = WRK-DOC-NO DTSBU549 00570 MOVE MJRN-KEY-AREA TO WRK-MJRN-FOUND-KEY. DTSBU549 00571 DTSBU549 00572 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBU549 00573 P5111-EXIT. DTSBU549 00574 EXIT. DTSBU549 00575 EJECT DTSBU549 00576 S1100-INIT-MJRN. DTSBU549 00577 MOVE LOW-VALUES TO MJRN-REC. DTSBU549 00578 DTSBU549 00579 MOVE WRK-EMP-NO TO MJRN-EMP-NO. DTSBU549 00580 DTSBU549 00581 SET MJRN-JRN-88 TO TRUE. DTSBU549 00582 DTSBU549 00583 MOVE WRK-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBU549 00584 DTSBU549 00585 MOVE +0 TO MJRN-PURGE-DATE. DTSBU549 00586 DTSBU549 00587 MOVE WRK-DOC-NO TO MJRN-DOC-NO. DTSBU549 00588 DTSBU549 00589 MOVE WRK-REC-TYPE TO MJRN-TRAN-CATEGORY. DTSBU549 00590 DTSBU549 00591 MOVE WRK-TRANS-TYPE TO MJRN-TRAN-TYPE. DTSBU549 00592 DTSBU549 00593 MOVE WRK-RECEIVED-DATE TO MJRN-RECEIVED-DATE. DTSBU549 00594 DTSBU549 00595 MOVE WRK-DEPOSIT-DATE TO MJRN-DEPOSIT-DATE. DTSBU549 00596 DTSBU549 00597 MOVE WRK-EMP-CLASS TO MJRN-EMP-CLASS. DTSBU549 00598 DTSBU549 00599 MOVE WRK-EMP-ELIGIBLE-CD TO MJRN-ELIGIBLE-CD. DTSBU549 00600 DTSBU549 00601 MOVE WRK-RESP-ACTIVITY TO MJRN-RESPONSIBLE-ACTIVITY. DTSBU549 00602 DTSBU549 00603 MOVE WRK-RESP-OP-ID TO MJRN-RESPONSIBLE-OP-ID. DTSBU549 00604 DTSBU549 00605 SET MJRN-NOT-CONVERTED-88 TO TRUE. DTSBU549 00606 DTSBU549 00607 MOVE WRK-CURR-RUN-DATE TO MJRN-ESTB-DATE. DTSBU549 00608 DTSBU549 00609 MOVE +0 TO MJRN-OCC-CNT. DTSBU549 00610 S1100-EXIT. DTSBU549 00611 EXIT. DTSBU549 00612 SKIP3 DTSBU549 00613 S1200-INIT-R302-TRAN-DATA. DTSBU549 00614 MOVE WRK-DEPOSIT-DATE TO R302-DEPOSIT-DATE. DTSBU549 00615 DTSBU549 00616 MOVE WRK-BATCH-NO TO R302-BATCH-NO. DTSBU549 00617 DTSBU549 00618 MOVE WRK-ITEM-NO TO R302-ITEM-NO. DTSBU549 00619 DTSBU549 00620 MOVE WRK-EMP-NO TO R302-EMP-NO. DTSBU549 00621 DTSBU549 00622 SET R302-TRAN-DATA-88 TO TRUE. DTSBU549 00623 DTSBU549 00624 MOVE +0 TO R302-SORT-YRQ DTSBU549 00625 R302-SORT-ACCT-SEQ. DTSBU549 00626 DTSBU549 00627 MOVE SPACE TO R302-SORT-ACCT-IND. DTSBU549 00628 DTSBU549 00629 MOVE LOW-VALUES TO R302-TRAN-DATA-AREA. DTSBU549 00630 DTSBU549 00631 MOVE WRK-CURR-RUN-DATE TO R302-CURR-RUN-DATE. DTSBU549 00632 DTSBU549 00633 MOVE WRK-RECEIVED-DATE TO R302-RECEIVED-DATE. DTSBU549 00634 DTSBU549 00635 MOVE WRK-REC-TYPE TO R302-ACCT-REC-TYPE. DTSBU549 00636 DTSBU549 00637 MOVE WRK-TRANS-TYPE TO R302-TRANS-TYPE. DTSBU549 00638 DTSBU549 00639 MOVE WRK-APPLIC-YRQ TO R302-APPLIC-YRQ. DTSBU549 00640 DTSBU549 00641 MOVE WRK-APPLIC-ACCT-IND TO R302-APPLIC-ACCT-IND. DTSBU549 00642 DTSBU549 00643 MOVE WRK-APPLIC-DOC-NO TO R302-APPLIC-DOC-NO. DTSBU549 00644 DTSBU549 00645 MOVE WRK-WAIVE-INT-IND TO R302-WAIVE-INT-IND. DTSBU549 00646 DTSBU549 00647 MOVE WRK-WAIVE-LATE-PEN-IND TO R302-WAIVE-LATE-PEN-IND. DTSBU549 00648 DTSBU549 00649 MOVE WRK-REMIT-AMT TO R302-REMIT-AMT. DTSBU549 00650 DTSBU549 00651 MOVE WRK-TOT-WAGE-CHNG TO R302-TOT-WAGE-CHNG. DTSBU549 00652 DTSBU549 00653 MOVE WRK-TAX-WAGE-CHNG TO R302-TAX-WAGE-CHNG. DTSBU549 00654 DTSBU549 00655 SET R302-OK-88 TO TRUE. DTSBU549 00656 S1200-EXIT. DTSBU549 00657 EXIT. DTSBU549 00658 EJECT DTSBU549 00659 S2100-WRK-DET-PROCESS. DTSBU549 00660 IF (WRK-DET-CHARGED-AMT (WRK-DET-IDX) = +0) DTSBU549 00661 AND DTSBU549 00662 (WRK-DET-PAID-AMT (WRK-DET-IDX) = +0) DTSBU549 00663 AND DTSBU549 00664 (WRK-DET-WAIVED-AMT (WRK-DET-IDX) = +0) DTSBU549 00665 AND DTSBU549 00666 (WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) = +0) DTSBU549 00667 AND DTSBU549 00668 (WRK-DET-TOLER-AMT (WRK-DET-IDX) = +0) DTSBU549 00669 GO TO S2100-EXIT. DTSBU549 00670 DTSBU549 00671 IF WRK-DET-ACCT-IND (WRK-DET-IDX) = CACT-ACCT-CREDIT DTSBU549 00672 PERFORM S2110-CREDIT THRU S2110-EXIT DTSBU549 00673 ELSE DTSBU549 00674 PERFORM S2120-NOT-CREDIT THRU S2120-EXIT. DTSBU549 00675 S2100-EXIT. DTSBU549 00676 EXIT. DTSBU549 00677 EJECT DTSBU549 00678 S2110-CREDIT. DTSBU549 00679 COMPUTE WRK-CREDIT-PAID-AMT DTSBU549 00680 = WRK-DET-PAID-AMT (WRK-DET-IDX) DTSBU549 00681 + WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) DTSBU549 00682 + WRK-DET-TOLER-AMT (WRK-DET-IDX). DTSBU549 00683 DTSBU549 00684 IF WRK-CREDIT-PAID-AMT = +0 DTSBU549 00685 NEXT SENTENCE DTSBU549 00686 ELSE DTSBU549 00687 PERFORM S2111-CREDIT-PAID-MJRN THRU S2111-EXIT. DTSBU549 00688 DTSBU549 00689 IF WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) = +0 DTSBU549 00690 NEXT SENTENCE DTSBU549 00691 ELSE DTSBU549 00692 PERFORM S2112-CREDIT-WRITTEN-OFF-MJRN THRU S2112-EXIT. DTSBU549 00693 DTSBU549 00694 IF WRK-DET-TOLER-AMT (WRK-DET-IDX) = +0 DTSBU549 00695 NEXT SENTENCE DTSBU549 00696 ELSE DTSBU549 00697 PERFORM S2113-CREDIT-TOLER-MJRN THRU S2113-EXIT. DTSBU549 00698 DTSBU549 00699 DTSBU549 00700 MOVE ALL-NINES-YRQ TO R302-SORT-YRQ. DTSBU549 00701 DTSBU549 00702 MOVE +0 TO R302-SORT-ACCT-SEQ. DTSBU549 00703 DTSBU549 00704 MOVE CACT-ACCT-CREDIT TO R302-SORT-ACCT-IND. DTSBU549 00705 DTSBU549 00706 MOVE CACT-CREDIT-YRQ TO R302-YRQ. DTSBU549 00707 DTSBU549 00708 MOVE CACT-ACCT-CREDIT TO R302-ACCT-IND. DTSBU549 00709 DTSBU549 00710 MOVE +0 TO R302-CHARGED-AMT. DTSBU549 00711 DTSBU549 00712 MOVE WRK-CREDIT-PAID-AMT TO R302-PAID-AMT. DTSBU549 00713 DTSBU549 00714 MOVE +0 TO R302-WAIVED-AMT. DTSBU549 00715 DTSBU549 00716 COMPUTE R302-WRITTEN-OFF-AMT DTSBU549 00717 = WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) * -1. DTSBU549 00718 DTSBU549 00719 COMPUTE R302-TOLER-AMT DTSBU549 00720 = WRK-DET-TOLER-AMT (WRK-DET-IDX) * -1. DTSBU549 00721 DTSBU549 00722 IF (R302-PAID-AMT = +0) DTSBU549 00723 AND DTSBU549 00724 (R302-WRITTEN-OFF-AMT = +0) DTSBU549 00725 AND DTSBU549 00726 (R302-TOLER-AMT = +0) DTSBU549 00727 NEXT SENTENCE DTSBU549 00728 ELSE DTSBU549 00729 PERFORM S9200-R302-WRITE THRU S9200-EXIT. DTSBU549 00730 S2110-EXIT. DTSBU549 00731 EXIT. DTSBU549 00732 SKIP3 DTSBU549 00733 S2111-CREDIT-PAID-MJRN. DTSBU549 00734 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00735 NEXT SENTENCE DTSBU549 00736 ELSE DTSBU549 00737 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00738 DTSBU549 00739 DTSBU549 00740 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00741 DTSBU549 00742 MOVE CACT-ACCT-CREDIT TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00743 DTSBU549 00744 MOVE CACT-CAT-PAID TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00745 DTSBU549 00746 MOVE CACT-CREDIT-YRQ TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00747 DTSBU549 00748 MOVE WRK-CREDIT-PAID-AMT TO MJRN-AMT (MJRN-OCC-CNT). DTSBU549 00749 S2111-EXIT. DTSBU549 00750 EXIT. DTSBU549 00751 SKIP3 DTSBU549 00752 S2112-CREDIT-WRITTEN-OFF-MJRN. DTSBU549 00753 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00754 NEXT SENTENCE DTSBU549 00755 ELSE DTSBU549 00756 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00757 DTSBU549 00758 DTSBU549 00759 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00760 DTSBU549 00761 MOVE CACT-ACCT-CREDIT TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00762 DTSBU549 00763 MOVE CACT-CAT-WRITTEN-OFF TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00764 DTSBU549 00765 MOVE CACT-CREDIT-YRQ TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00766 DTSBU549 00767 COMPUTE MJRN-AMT (MJRN-OCC-CNT) DTSBU549 00768 = WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) * -1. DTSBU549 00769 S2112-EXIT. DTSBU549 00770 EXIT. DTSBU549 00771 SKIP3 DTSBU549 00772 S2113-CREDIT-TOLER-MJRN. DTSBU549 00773 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00774 NEXT SENTENCE DTSBU549 00775 ELSE DTSBU549 00776 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00777 DTSBU549 00778 DTSBU549 00779 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00780 DTSBU549 00781 MOVE CACT-ACCT-CREDIT TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00782 DTSBU549 00783 MOVE CACT-CAT-TOLER TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00784 DTSBU549 00785 MOVE CACT-CREDIT-YRQ TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00786 DTSBU549 00787 COMPUTE MJRN-AMT (MJRN-OCC-CNT) DTSBU549 00788 = WRK-DET-TOLER-AMT (WRK-DET-IDX) * -1. DTSBU549 00789 S2113-EXIT. DTSBU549 00790 EXIT. DTSBU549 00791 EJECT DTSBU549 00792 S2120-NOT-CREDIT. DTSBU549 00793 IF WRK-DET-CHARGED-AMT (WRK-DET-IDX) = +0 DTSBU549 00794 NEXT SENTENCE DTSBU549 00795 ELSE DTSBU549 00796 PERFORM S2121-CHARGED-MJRN THRU S2121-EXIT. DTSBU549 00797 DTSBU549 00798 IF WRK-DET-PAID-AMT (WRK-DET-IDX) = +0 DTSBU549 00799 NEXT SENTENCE DTSBU549 00800 ELSE DTSBU549 00801 PERFORM S2122-PAID-MJRN THRU S2122-EXIT. DTSBU549 00802 DTSBU549 00803 IF WRK-DET-WAIVED-AMT (WRK-DET-IDX) = +0 DTSBU549 00804 NEXT SENTENCE DTSBU549 00805 ELSE DTSBU549 00806 PERFORM S2123-WAIVED-MJRN THRU S2123-EXIT. DTSBU549 00807 DTSBU549 00808 IF WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) = +0 DTSBU549 00809 NEXT SENTENCE DTSBU549 00810 ELSE DTSBU549 00811 PERFORM S2124-WRITTEN-OFF-MJRN THRU S2124-EXIT. DTSBU549 00812 DTSBU549 00813 IF WRK-DET-TOLER-AMT (WRK-DET-IDX) = +0 DTSBU549 00814 NEXT SENTENCE DTSBU549 00815 ELSE DTSBU549 00816 PERFORM S2125-TOLER-MJRN THRU S2125-EXIT. DTSBU549 00817 DTSBU549 00818 IF WRK-DET-YRQ (WRK-DET-IDX) = WRK-APPLIC-YRQ DTSBU549 00819 MOVE +0 TO R302-SORT-YRQ DTSBU549 00820 ELSE DTSBU549 00821 MOVE WRK-DET-YRQ (WRK-DET-IDX) TO R302-SORT-YRQ. DTSBU549 00822 DTSBU549 00823 MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) TO R302-SORT-ACCT-IND. DTSBU549 00824 DTSBU549 00825 SET CACT-ACCT-IDX TO 1. DTSBU549 00826 DTSBU549 00827 SEARCH CACT-ACCT-LIT DTSBU549 00828 AT END DTSBU549 00829 MOVE +32 TO R302-SORT-ACCT-SEQ DTSBU549 00830 WHEN DTSBU549 00831 R302-SORT-ACCT-IND DTSBU549 00832 = CACT-ACCT-LIT (CACT-ACCT-IDX) DTSBU549 00833 SET R302-SORT-ACCT-SEQ TO CACT-ACCT-IDX. DTSBU549 00834 DTSBU549 00835 ***** DTSBU549 00836 ***** DTSBU549 00837 *****REVERSE 'P ' AND 'I ' ON R302 DETAIL LINES ONLY. DTSBU549 00838 *****PER DANITA 03/14/95. DTSBU549 00839 ***** DTSBU549 00840 ***** DTSBU549 00841 DTSBU549 00842 *****IF R302-SORT-ACCT-SEQ = +5 DTSBU549 00843 *********MOVE +6 TO R302-SORT-ACCT-SEQ DTSBU549 00844 *****ELSE DTSBU549 00845 *****IF R302-SORT-ACCT-SEQ = +6 DTSBU549 00846 *********MOVE +5 TO R302-SORT-ACCT-SEQ. DTSBU549 00847 DTSBU549 00848 MOVE WRK-DET-YRQ (WRK-DET-IDX) TO R302-YRQ. DTSBU549 00849 DTSBU549 00850 MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) TO R302-ACCT-IND. DTSBU549 00851 DTSBU549 00852 MOVE WRK-DET-CHARGED-AMT (WRK-DET-IDX) TO R302-CHARGED-AMT. DTSBU549 00853 DTSBU549 00854 MOVE WRK-DET-PAID-AMT (WRK-DET-IDX) TO R302-PAID-AMT. DTSBU549 00855 DTSBU549 00856 MOVE WRK-DET-WAIVED-AMT (WRK-DET-IDX) TO R302-WAIVED-AMT. DTSBU549 00857 DTSBU549 00858 MOVE WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) DTSBU549 00859 TO R302-WRITTEN-OFF-AMT. DTSBU549 00860 DTSBU549 00861 MOVE WRK-DET-TOLER-AMT (WRK-DET-IDX) TO R302-TOLER-AMT. DTSBU549 00862 DTSBU549 00863 PERFORM S9200-R302-WRITE THRU S9200-EXIT. DTSBU549 00864 S2120-EXIT. DTSBU549 00865 EXIT. DTSBU549 00866 SKIP3 DTSBU549 00867 S2121-CHARGED-MJRN. DTSBU549 00868 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00869 NEXT SENTENCE DTSBU549 00870 ELSE DTSBU549 00871 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00872 DTSBU549 00873 DTSBU549 00874 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00875 DTSBU549 00876 MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) DTSBU549 00877 TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00878 DTSBU549 00879 MOVE CACT-CAT-CHARGED DTSBU549 00880 TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00881 DTSBU549 00882 MOVE WRK-DET-YRQ (WRK-DET-IDX) DTSBU549 00883 TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00884 DTSBU549 00885 MOVE WRK-DET-CHARGED-AMT (WRK-DET-IDX) DTSBU549 00886 TO MJRN-AMT (MJRN-OCC-CNT). DTSBU549 00887 S2121-EXIT. DTSBU549 00888 EXIT. DTSBU549 00889 SKIP3 DTSBU549 00890 S2122-PAID-MJRN. DTSBU549 00891 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00892 NEXT SENTENCE DTSBU549 00893 ELSE DTSBU549 00894 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00895 DTSBU549 00896 DTSBU549 00897 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00898 DTSBU549 00899 MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) DTSBU549 00900 TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00901 DTSBU549 00902 MOVE CACT-CAT-PAID DTSBU549 00903 TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00904 DTSBU549 00905 MOVE WRK-DET-YRQ (WRK-DET-IDX) DTSBU549 00906 TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00907 DTSBU549 00908 MOVE WRK-DET-PAID-AMT (WRK-DET-IDX) DTSBU549 00909 TO MJRN-AMT (MJRN-OCC-CNT). DTSBU549 00910 S2122-EXIT. DTSBU549 00911 EXIT. DTSBU549 00912 SKIP3 DTSBU549 00913 S2123-WAIVED-MJRN. DTSBU549 00914 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00915 NEXT SENTENCE DTSBU549 00916 ELSE DTSBU549 00917 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00918 DTSBU549 00919 DTSBU549 00920 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00921 DTSBU549 00922 MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) DTSBU549 00923 TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00924 DTSBU549 00925 MOVE CACT-CAT-WAIVED DTSBU549 00926 TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00927 DTSBU549 00928 MOVE WRK-DET-YRQ (WRK-DET-IDX) DTSBU549 00929 TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00930 DTSBU549 00931 MOVE WRK-DET-WAIVED-AMT (WRK-DET-IDX) DTSBU549 00932 TO MJRN-AMT (MJRN-OCC-CNT). DTSBU549 00933 S2123-EXIT. DTSBU549 00934 EXIT. DTSBU549 00935 SKIP3 DTSBU549 00936 S2124-WRITTEN-OFF-MJRN. DTSBU549 00937 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00938 NEXT SENTENCE DTSBU549 00939 ELSE DTSBU549 00940 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00941 DTSBU549 00942 DTSBU549 00943 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00944 DTSBU549 00945 MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) DTSBU549 00946 TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00947 DTSBU549 00948 MOVE CACT-CAT-WRITTEN-OFF DTSBU549 00949 TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00950 DTSBU549 00951 MOVE WRK-DET-YRQ (WRK-DET-IDX) DTSBU549 00952 TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00953 DTSBU549 00954 MOVE WRK-DET-WRITTEN-OFF-AMT (WRK-DET-IDX) DTSBU549 00955 TO MJRN-AMT (MJRN-OCC-CNT). DTSBU549 00956 S2124-EXIT. DTSBU549 00957 EXIT. DTSBU549 00958 SKIP3 DTSBU549 00959 S2125-TOLER-MJRN. DTSBU549 00960 IF MJRN-OCC-CNT < MMAX-JRN-ACCT-MAX DTSBU549 00961 NEXT SENTENCE DTSBU549 00962 ELSE DTSBU549 00963 PERFORM S9100-MJRN-WRITE THRU S9100-EXIT. DTSBU549 00964 DTSBU549 00965 DTSBU549 00966 ADD +1 TO MJRN-OCC-CNT. DTSBU549 00967 DTSBU549 00968 MOVE WRK-DET-ACCT-IND (WRK-DET-IDX) DTSBU549 00969 TO MJRN-ACCT-ROW (MJRN-OCC-CNT). DTSBU549 00970 DTSBU549 00971 MOVE CACT-CAT-TOLER DTSBU549 00972 TO MJRN-ACCT-COL (MJRN-OCC-CNT). DTSBU549 00973 DTSBU549 00974 MOVE WRK-DET-YRQ (WRK-DET-IDX) DTSBU549 00975 TO MJRN-YRQ (MJRN-OCC-CNT). DTSBU549 00976 DTSBU549 00977 MOVE WRK-DET-TOLER-AMT (WRK-DET-IDX) DTSBU549 00978 TO MJRN-AMT (MJRN-OCC-CNT). DTSBU549 00979 S2125-EXIT. DTSBU549 00980 EXIT. DTSBU549 00981 EJECT DTSBU549 00982 S9100-MJRN-WRITE. DTSBU549 00983 MOVE MJRN-REC TO MSKL-REC. DTSBU549 00984 DTSBU549 00985 PERFORM S910-WRITE THRU S910-EXIT. DTSBU549 00986 DTSBU549 00987 ADD +1 TO MJRN-ESTB-ABSTIME DTSBU549 00988 WRK-MJRN-CNT. DTSBU549 00989 DTSBU549 00990 MOVE +0 TO MJRN-OCC-CNT. DTSBU549 00991 S9100-EXIT. DTSBU549 00992 EXIT. DTSBU549 00993 SKIP3 DTSBU549 00994 S9200-R302-WRITE. DTSBU549 00995 PERFORM S946-R302-WRITE THRU S946-EXIT. DTSBU549 00996 DTSBU549 00997 ADD +1 TO WRK-R302-CNT. DTSBU549 00998 S9200-EXIT. DTSBU549 00999 EXIT. DTSBU549 01000 EJECT DTSBU549 01001 S910-READ. DTSBU549 01002 SET L910-READ-88 TO TRUE. DTSBU549 01003 GO TO S910-MSTR-IO. DTSBU549 01004 DTSBU549 01005 S910-START-BROWSE. DTSBU549 01006 SET L910-START-BROWSE-88 TO TRUE. DTSBU549 01007 GO TO S910-MSTR-IO. DTSBU549 01008 DTSBU549 01009 S910-READ-NEXT. DTSBU549 01010 SET L910-READ-NEXT-88 TO TRUE. DTSBU549 01011 GO TO S910-MSTR-IO. DTSBU549 01012 DTSBU549 01013 *S910-COUNT. DTSBU549 01014 *****SET L910-COUNT-88 TO TRUE. DTSBU549 01015 *****GO TO S910-MSTR-IO. DTSBU549 01016 DTSBU549 01017 S910-WRITE. DTSBU549 01018 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU549 01019 SET L910-WRITE-88 TO TRUE. DTSBU549 01020 GO TO S910-MSTR-IO. DTSBU549 01021 DTSBU549 01022 *S910-REWRITE. DTSBU549 01023 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU549 01024 *****SET L910-REWRITE-88 TO TRUE. DTSBU549 01025 *****GO TO S910-MSTR-IO. DTSBU549 01026 DTSBU549 01027 S910-DELETE. DTSBU549 01028 *****SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBU549 01029 SET L910-DELETE-88 TO TRUE. DTSBU549 01030 GO TO S910-MSTR-IO. DTSBU549 01031 DTSBU549 01032 S910-MSTR-IO. DTSBU549 01033 CALL 'DTSBU910' USING L910-LINK-AREA DTSBU549 01034 MSKL-REC. DTSBU549 01035 S910-EXIT. DTSBU549 01036 EXIT. DTSBU549 01037 SKIP3 DTSBU549 01038 S946-R302-WRITE. DTSBU549 01039 CALL 'DTSBU946' USING R302-REC. DTSBU549 01040 S946-EXIT. DTSBU549 01041 EXIT. DTSBU549 01042 SKIP3 DTSBU549 01043 S999-ABEND. DTSBU549 01044 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU549 01045 S999-EXIT. DTSBU549 01046 EXIT. DTSBU549