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
