1048 lines
83 KiB
COBOL
1048 lines
83 KiB
COBOL
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
|