116 lines
9.1 KiB
COBOL
116 lines
9.1 KiB
COBOL
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
|