00001 IDENTIFICATION DIVISION. 04/01/13 00002 PROGRAM-ID. DTSBU120. DTSBU120 00003 AUTHOR. NGC. LV001 00004 DATE-WRITTEN. FEBRUARY 2013. DTSBU120 00005 DATE-COMPILED. DTSBU120 00006 SKIP3 DTSBU120 00007 ***** DTSBU120 00008 * DTSBU120 00009 * FUNCTION: LATE PENALTY PERCENTAGE LOOKUP. DTSBU120 00010 * DTSBU120 00011 * LATE PENALTY IS CALCULATED AS $100.00 OR A PERCENTAGE DTSBU120 00012 * OF THE BALANCE DUE. PERCENTAGE IS 10% AS OF 1ST QTR 2013. DTSBU120 00013 * DTSBU120 00014 * CHANGES TO THE PERCENTAGE ARE TRACKED IN A WORKING- DTSBU120 00015 * STORAGE TABLE: W-PCT-TABLE. DTSBU120 00016 * DTSBU120 00017 * MODIFICATION LOG: DTSBU120 00018 * DTSBU120 00019 * 02/14/2013 INITIAL DEVELOPMENT. DTSBU120 00020 * WORK ORDER: PROGRAMMER: TCL DTSBU120 00021 * DTSBU120 00022 * DTSBU120 00023 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU120 00024 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU120 00025 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU120 00026 * DTSBU120 00027 * DTSBU120 00028 * DESCRIPTION: DTSBU120 00029 * DTSBU120 00030 * DTSBU120 00031 ***** DTSBU120 00032 SKIP2 DTSBU120 00033 ENVIRONMENT DIVISION. DTSBU120 00034 DTSBU120 00035 DTSBU120 00036 DTSBU120 00037 DATA DIVISION. DTSBU120 00038 DTSBU120 00039 DTSBU120 00040 DTSBU120 00041 WORKING-STORAGE SECTION. DTSBU120 000415 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU120 04/01/13'. DTSBU120 00042 77 PAN-VALET PICTURE X(24) VALUE '008DTSBU120 03/06/13'. DTSBU120 00043 77 PAN-VALET PICTURE X(24) VALUE '012DTSBU109 04/30/08'. DTSBU120 00044 DTSBU120 00045 01 WRK-AREA. DTSBU120 00046 DTSBU120 00047 05 W-ABEND-CODE PIC S9(04) COMP DTSBU120 00048 VALUE +120. DTSBU120 00049 DTSBU120 00050 05 W-LATE-PENALTY-PCT PIC S9V9(04) COMP-3. DTSBU120 00051 DTSBU120 00052 ********************************************************* DTSBU120 00053 05 W-PCT-TABLE. DTSBU120 00054 **** ENTRY 1 **** DTSBU120 00055 10 FILLER PIC S9(05) COMP-3 DTSBU120 00056 VALUE +00000. DTSBU120 00057 10 FILLER PIC S9(05) COMP-3 DTSBU120 00058 VALUE +99999. DTSBU120 00059 10 FILLER PIC S9V9(04) COMP-3 DTSBU120 00060 VALUE +0.10. DTSBU120 00061 **** ENTRY 2 **** DTSBU120 00062 * 10 FILLER PIC S9(05) COMP-3 DTSBU120 00063 * VALUE +20124. DTSBU120 00064 * 10 FILLER PIC S9(05) COMP-3 DTSBU120 00065 * VALUE +99999. DTSBU120 00066 * 10 FILLER PIC S9V9(04) COMP-3 DTSBU120 00067 * VALUE +0.25. DTSBU120 00068 05 FILLER REDEFINES W-PCT-TABLE. DTSBU120 00069 10 W-PCT-ENTRY OCCURS 1 TIMES DTSBU120 00070 INDEXED BY PCT-IDX. DTSBU120 00071 15 W-START-YRQ PIC S9(05) COMP-3. DTSBU120 00072 15 W-END-YRQ PIC S9(05) COMP-3. DTSBU120 00073 15 W-PCT PIC S9V9(04) COMP-3. DTSBU120 00074 EJECT DTSBU120 00075 LINKAGE SECTION. DTSBU120 00076 SKIP3 DTSBU120 00077 01 L120-LINK-AREA. DTSBU120 00078 ++INCLUDE DTSIL120 DTSBU120 00079 EJECT DTSBU120 00080 PROCEDURE DIVISION USING L120-LINK-AREA. DTSBU120 00081 DTSBU120 00082 DTSBU120 00083 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU120 00084 DTSBU120 00085 DTSBU120 00086 GOBACK. DTSBU120 00087 EJECT DTSBU120 00088 P0000-PROCESS. DTSBU120 00089 MOVE +0 TO W-LATE-PENALTY-PCT. DTSBU120 00090 DTSBU120 00091 SET PCT-IDX TO 1. DTSBU120 00092 SEARCH W-PCT-ENTRY DTSBU120 00093 VARYING PCT-IDX DTSBU120 00094 AT END DTSBU120 00095 DISPLAY 'DTSBU120 - CANNOT FIND LATE PENALTY' DTSBU120 00096 'DTSBU120 - CANNOT FIND LATE PENALTY PERCENT' DTSBU120 00097 L120-YRQ DTSBU120 00098 PERFORM S999-ABEND THRU S999-EXIT DTSBU120 00099 WHEN L120-YRQ >= W-START-YRQ (PCT-IDX) DTSBU120 00100 AND <= W-END-YRQ (PCT-IDX) DTSBU120 00101 MOVE W-PCT (PCT-IDX) DTSBU120 00102 TO W-LATE-PENALTY-PCT DTSBU120 00103 END-SEARCH. DTSBU120 00104 DTSBU120 00105 MOVE W-LATE-PENALTY-PCT TO L120-LATE-PENALTY-PCT. DTSBU120 00106 DTSBU120 00107 P0000-EXIT. DTSBU120 00108 EXIT. DTSBU120 00109 DTSBU120 00110 DTSBU120 00111 S999-ABEND. DTSBU120 00112 CALL 'DTSBU999' USING W-ABEND-CODE. DTSBU120 00113 S999-EXIT. DTSBU120 00114 EXIT. DTSBU120