100 lines
7.8 KiB
COBOL
100 lines
7.8 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/11/98
|
|
00002 PROGRAM-ID. DTSCU012 DTSCU012
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
|
00004 DATE-WRITTEN SEPTEMBER 1998. CL**3
|
|
00005 DATE-COMPILED. DTSCU012
|
|
00006 SKIP3 DTSCU012
|
|
00007 ***** DTSCU012
|
|
00008 * DTSCU012
|
|
00009 * FUNCTION: EDIT AND FORMAT RATES FROM SCREEN DTSCU012
|
|
00010 * DTSCU012
|
|
00011 * DTSCU012
|
|
00012 * MODIFICATION LOG: DTSCU012
|
|
00013 * DTSCU012
|
|
00014 * 08/07/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCU012. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: GD CL**2
|
|
00016 * DTSCU012
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU012
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU012
|
|
00019 * WORK ORDER: PROGRAMMER: DTSCU012
|
|
00020 * DTSCU012
|
|
00021 * DTSCU012
|
|
00022 * DTSCU012
|
|
00023 ***** DTSCU012
|
|
00024 SKIP3 DTSCU012
|
|
00025 ENVIRONMENT DIVISION. DTSCU012
|
|
00026 DATA DIVISION. DTSCU012
|
|
00027 SKIP3 DTSCU012
|
|
00028 WORKING-STORAGE SECTION. DTSCU012
|
|
000285 77 PAN-VALET PICTURE X(24) VALUE '003DTSCU012 09/11/98'. DTSCU012
|
|
00029 01 WRK-AREA. DTSCU012
|
|
00030 05 TO-RIGHT-CNT PIC S9(04) COMP. DTSCU012
|
|
00031 05 WS-SUB PIC S9(04) COMP. DTSCU012
|
|
00032 05 IN-SUB PIC S9(04) COMP. DTSCU012
|
|
00033 05 DECIMAL-FOUND-IND PIC X(01). DTSCU012
|
|
00034 05 WS-OUTPUT-AREA PIC 9(04). CL**3
|
|
00035 LINKAGE SECTION. DTSCU012
|
|
00036 01 DFHCOMMAREA. DTSCU012
|
|
00037 ++INCLUDE DTSIL012 CL**2
|
|
00038 PROCEDURE DIVISION. DTSCU012
|
|
00039 SKIP2 DTSCU012
|
|
00040 DTSCU012-MAIN. CL**2
|
|
00041 INSPECT L012-S-RATE CONVERTING LOW-VALUE TO SPACE. DTSCU012
|
|
00042 IF L012-S-RATE = SPACE DTSCU012
|
|
00043 SET L012-NO-ENTRY TO TRUE CL**2
|
|
00044 MOVE ZERO TO L012-RATE DTSCU012
|
|
00045 GO TO DTSCU012-RETURN. CL**2
|
|
00046 SET L012-VALID TO TRUE. CL**2
|
|
00047 MOVE +0 TO L012-RATE. DTSCU012
|
|
00048 MOVE 0 TO WS-OUTPUT-AREA. DTSCU012
|
|
00049 MOVE 'N' TO DECIMAL-FOUND-IND. DTSCU012
|
|
00050 MOVE +0 TO TO-RIGHT-CNT. DTSCU012
|
|
00051 MOVE +5 TO WS-SUB. CL**3
|
|
00052 PERFORM P1000-LOOP THRU P1000-EXIT DTSCU012
|
|
00053 VARYING IN-SUB FROM 4 BY -1 CL**3
|
|
00054 UNTIL IN-SUB < 1. DTSCU012
|
|
00055 IF L012-NOT-VALID DTSCU012
|
|
00056 GO TO DTSCU012-RETURN. CL**2
|
|
00057 IF DECIMAL-FOUND-IND = 'N' DTSCU012
|
|
00058 MOVE +1 TO TO-RIGHT-CNT. DTSCU012
|
|
00059 SKIP1 DTSCU012
|
|
00060 IF TO-RIGHT-CNT = 0 DTSCU012
|
|
00061 SET L012-NOT-VALID TO TRUE CL**2
|
|
00062 GO TO DTSCU012-RETURN. CL**2
|
|
00063 IF TO-RIGHT-CNT = +1 DTSCU012
|
|
00064 COMPUTE L012-RATE = WS-OUTPUT-AREA / 1000 DTSCU012
|
|
00065 ELSE DTSCU012
|
|
00066 IF TO-RIGHT-CNT = +2 DTSCU012
|
|
00067 COMPUTE L012-RATE = WS-OUTPUT-AREA / 10000 DTSCU012
|
|
00068 ELSE DTSCU012
|
|
00069 SET L012-NOT-VALID TO TRUE. CL**2
|
|
00070 DTSCU012-RETURN. CL**2
|
|
00071 EXEC CICS DTSCU012
|
|
00072 RETURN DTSCU012
|
|
00073 END-EXEC. DTSCU012
|
|
00074 GOBACK. DTSCU012
|
|
00075 P1000-LOOP. DTSCU012
|
|
00076 IF L012-S-RATE (IN-SUB : 1) = SPACE DTSCU012
|
|
00077 GO TO P1000-EXIT. DTSCU012
|
|
00078 SKIP1 DTSCU012
|
|
00079 IF L012-S-RATE (IN-SUB : 1) = '.' DTSCU012
|
|
00080 IF DECIMAL-FOUND-IND = 'Y' DTSCU012
|
|
00081 SET L012-NOT-VALID TO TRUE CL**2
|
|
00082 GO TO P1000-EXIT DTSCU012
|
|
00083 ELSE DTSCU012
|
|
00084 MOVE 'Y' TO DECIMAL-FOUND-IND DTSCU012
|
|
00085 GO TO P1000-EXIT. DTSCU012
|
|
00086 SKIP1 DTSCU012
|
|
00087 IF L012-S-RATE (IN-SUB : 1) NUMERIC DTSCU012
|
|
00088 SUBTRACT 1 FROM WS-SUB DTSCU012
|
|
00089 MOVE L012-S-RATE (IN-SUB : 1) DTSCU012
|
|
00090 TO WS-OUTPUT-AREA (WS-SUB : 1) DTSCU012
|
|
00091 IF DECIMAL-FOUND-IND = 'N' DTSCU012
|
|
00092 ADD +1 TO TO-RIGHT-CNT DTSCU012
|
|
00093 ELSE DTSCU012
|
|
00094 NEXT SENTENCE DTSCU012
|
|
00095 ELSE DTSCU012
|
|
00096 SET L012-NOT-VALID TO TRUE. CL**2
|
|
00097 P1000-EXIT. DTSCU012
|
|
00098 EXIT. DTSCU012
|