181 lines
14 KiB
COBOL
181 lines
14 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/13/98
|
|
00002 PROGRAM-ID. DTSBU541. DTSBU541
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN. JANUARY 1991. CL**2
|
|
00005 DATE-COMPILED. CL**2
|
|
00006 SKIP3 CL**2
|
|
00007 ***** CL**2
|
|
00008 * CL**2
|
|
00009 * FUNCTION: MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED CL**3
|
|
00010 * OR WRITTEN OFF AMOUNT IN A QUARTER (MQTR) CL**3
|
|
00011 * RECORD. CL**3
|
|
00012 * CL**3
|
|
00013 * CL**2
|
|
00014 * MODIFICATION LOG: CL**2
|
|
00015 * CL**2
|
|
00016 * 01/26/92 INITIAL DEVELOPMENT. CL**2
|
|
00017 * WORK ORDER: PROGRAMMER: TCL CL**2
|
|
00018 * CL**2
|
|
00019 * 12/13/1998 REVIEWED AND MODIFIED FOR DC. CL**3
|
|
00020 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**3
|
|
00021 * CL**3
|
|
00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
|
00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**3
|
|
00025 * CL**2
|
|
00026 * CL**2
|
|
00027 * DESCRIPTION: CL**2
|
|
00028 * CL**2
|
|
00029 * MODIFY THE ACCOUNTING AMOUNT DEFINED BY MQTR-REC, CL**2
|
|
00030 * L541-ACCT-SUB, AND L541-CAT-IND BY L541-AMT. CL**2
|
|
00031 * CL**2
|
|
00032 * MAINTAIN THE BALANCE DUE, MQTR LEVEL AMOUNTS CL**2
|
|
00033 * AND MPRF-BALANCE-DUE-AMT. CALL DTSBU549 TO CL**3
|
|
00034 * DO JOURNALING AND BATCH DETAIL LISTING. CL**2
|
|
00035 * CL**2
|
|
00036 * CL**2
|
|
00037 * NOTE: DTSBU541 DOES NOT DO ANY MASTER FILE I/O. CL**3
|
|
00038 * IF YOU FEEL A NEED TO INSERT MASTER FILE I/O CL**2
|
|
00039 * INTO DTSBU541, THEN YOU ARE PROBABLY MAKING CL**3
|
|
00040 * A MISTAKE. CL**2
|
|
00041 * CL**2
|
|
00042 * CL**2
|
|
00043 * MASTER FILE RECORDS READ: CL**2
|
|
00044 * CL**2
|
|
00045 * NONE CL**2
|
|
00046 * CL**2
|
|
00047 * CL**2
|
|
00048 * MASTER FILE RECORDS UPDATED: CL**2
|
|
00049 * CL**2
|
|
00050 * NONE CL**2
|
|
00051 * CL**2
|
|
00052 * CL**2
|
|
00053 * REPORT RECORDS WRITTEN: CL**2
|
|
00054 * CL**2
|
|
00055 * NONE. CL**2
|
|
00056 * CL**2
|
|
00057 * CL**2
|
|
00058 * MODULES CALLED: CL**2
|
|
00059 * CL**2
|
|
00060 * DTSBU549 JOURNALING/BATCH DETAIL LISTING. CL**3
|
|
00061 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. CL**3
|
|
00062 * CL**2
|
|
00063 * CL**2
|
|
00064 ***** CL**2
|
|
00065 SKIP3 CL**2
|
|
00066 ENVIRONMENT DIVISION. CL**2
|
|
00067 EJECT CL**2
|
|
00068 DATA DIVISION. CL**2
|
|
00069 SKIP3 CL**2
|
|
00070 WORKING-STORAGE SECTION. CL**2
|
|
000705 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU541 12/13/98'. CL**2
|
|
00071 SKIP3 CL**2
|
|
00072 01 WRK-AREA. CL**2
|
|
00073 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +541. CL**2
|
|
00074 CL**3
|
|
00075 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL**2
|
|
00076 EJECT CL**2
|
|
00077 01 L549-LINK-AREA. CL**2
|
|
00078 ++INCLUDE DTSIL549 CL**3
|
|
00079 EJECT CL**2
|
|
00080 01 CACT-LITERALS. CL**2
|
|
00081 ++INCLUDE DTSICACT CL**3
|
|
00082 EJECT CL**2
|
|
00083 LINKAGE SECTION. CL**2
|
|
00084 SKIP3 CL**2
|
|
00085 01 L541-LINK-AREA. CL**2
|
|
00086 ++INCLUDE DTSIL541 CL**3
|
|
00087 EJECT CL**2
|
|
00088 01 MPRF-REC. CL**2
|
|
00089 ++INCLUDE DTSIMPRF CL**3
|
|
00090 EJECT CL**2
|
|
00091 01 MQTR-REC. CL**2
|
|
00092 ++INCLUDE DTSIMQTR CL**3
|
|
00093 EJECT CL**2
|
|
00094 PROCEDURE DIVISION USING L541-LINK-AREA CL**2
|
|
00095 MPRF-REC CL**2
|
|
00096 MQTR-REC. CL**2
|
|
00097 CL**3
|
|
00098 CL**3
|
|
00099 IF FIRST-TIME-IND = 'Y' CL**2
|
|
00100 PERFORM I0000-INITIATE THRU I0000-EXIT CL**2
|
|
00101 MOVE 'N' TO FIRST-TIME-IND. CL**2
|
|
00102 CL**3
|
|
00103 CL**3
|
|
00104 IF L541-AMT NOT = 0 CL**2
|
|
00105 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**2
|
|
00106 CL**3
|
|
00107 CL**3
|
|
00108 GOBACK. CL**2
|
|
00109 EJECT CL**2
|
|
00110 I0000-INITIATE. CL**2
|
|
00111 I0000-EXIT. CL**2
|
|
00112 EXIT. CL**2
|
|
00113 EJECT CL**2
|
|
00114 P0000-PROCESS. CL**2
|
|
00115 MOVE MQTR-YRQ TO L549-DELTA-YRQ. CL**2
|
|
00116 CL**3
|
|
00117 MOVE MQTR-ACCT-IND (L541-ACCT-SUB) TO L549-DELTA-ACCT-IND. CL**2
|
|
00118 CL**3
|
|
00119 IF L541-CAT-IND = CACT-CAT-CHARGED CL**2
|
|
00120 ADD L541-AMT TO MQTR-CHARGED-AMT (L541-ACCT-SUB) CL**2
|
|
00121 ADD L541-AMT TO MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
|
00122 MPRF-TOT-BALANCE-AMT CL**2
|
|
00123 MOVE CACT-CAT-CHARGED TO L549-DELTA-CAT-IND CL**2
|
|
00124 IF MQTR-CHARGED-AMT (L541-ACCT-SUB) < +0 CL**2
|
|
00125 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
|
00126 ELSE CL**2
|
|
00127 NEXT SENTENCE CL**2
|
|
00128 ELSE CL**2
|
|
00129 IF L541-CAT-IND = CACT-CAT-WAIVED CL**3
|
|
00130 ADD L541-AMT TO MQTR-WAIVED-AMT (L541-ACCT-SUB) CL**3
|
|
00131 SUBTRACT L541-AMT FROM MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
|
00132 MPRF-TOT-BALANCE-AMT CL**2
|
|
00133 MOVE CACT-CAT-WAIVED TO L549-DELTA-CAT-IND CL**3
|
|
00134 IF MQTR-WAIVED-AMT (L541-ACCT-SUB) < +0 CL**3
|
|
00135 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
|
00136 ELSE CL**2
|
|
00137 NEXT SENTENCE CL**2
|
|
00138 ELSE CL**2
|
|
00139 IF L541-CAT-IND = CACT-CAT-WRITTEN-OFF CL**3
|
|
00140 ADD L541-AMT TO MQTR-WRITTEN-OFF-AMT (L541-ACCT-SUB) CL**3
|
|
00141 SUBTRACT L541-AMT FROM MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
|
00142 MPRF-TOT-BALANCE-AMT CL**2
|
|
00143 MOVE CACT-CAT-WRITTEN-OFF TO L549-DELTA-CAT-IND CL**3
|
|
00144 IF MQTR-WRITTEN-OFF-AMT (L541-ACCT-SUB) < +0 CL**3
|
|
00145 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
|
00146 ELSE CL**2
|
|
00147 NEXT SENTENCE CL**2
|
|
00148 ELSE CL**2
|
|
00149 IF L541-CAT-IND = CACT-CAT-TOLER CL**2
|
|
00150 ADD L541-AMT TO MQTR-TOLER-AMT (L541-ACCT-SUB) CL**2
|
|
00151 SUBTRACT L541-AMT FROM MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
|
00152 MPRF-TOT-BALANCE-AMT CL**2
|
|
00153 MOVE CACT-CAT-TOLER TO L549-DELTA-CAT-IND CL**2
|
|
00154 IF MQTR-TOLER-AMT (L541-ACCT-SUB) < +0 CL**2
|
|
00155 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
|
00156 ELSE CL**2
|
|
00157 NEXT SENTENCE CL**2
|
|
00158 ELSE CL**2
|
|
00159 PERFORM S999-ABEND THRU S999-EXIT. CL**2
|
|
00160 CL**3
|
|
00161 MOVE L541-AMT TO L549-DELTA-AMT. CL**2
|
|
00162 CL**3
|
|
00163 PERFORM S549-MJRN-TABLE THRU S549-EXIT. CL**2
|
|
00164 P0000-EXIT. CL**2
|
|
00165 EXIT. CL**2
|
|
00166 EJECT CL**2
|
|
00167 S549-MJRN-TABLE. CL**2
|
|
00168 SET L549-DELTA-88 TO TRUE. CL**2
|
|
00169 CL**3
|
|
00170 MOVE L541-TRN-DOC-NO TO L549-TRN-DOC-NO. CL**2
|
|
00171 CL**3
|
|
00172 CALL 'DTSBU549' USING L549-LINK-AREA. CL**3
|
|
00173 S549-EXIT. CL**2
|
|
00174 EXIT. CL**2
|
|
00175 SKIP3 CL**2
|
|
00176 S999-ABEND. CL**2
|
|
00177 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**3
|
|
00178 S999-EXIT. CL**2
|
|
00179 EXIT. CL**2
|