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