104 lines
8.1 KiB
COBOL
104 lines
8.1 KiB
COBOL
00001 IDENTIFICATION DIVISION. 09/22/98
|
|
00002 PROGRAM-ID. DTSCU011 DTSCU011
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV006
|
|
00004 DATE-WRITTEN DECEMBER 1991. DTSCU011
|
|
00005 DATE-COMPILED. DTSCU011
|
|
00006 SKIP3 DTSCU011
|
|
00007 ***** DTSCU011
|
|
00008 * DTSCU011
|
|
00009 * FUNCTION: EDIT AND FORMAT MONEY AMOUNT FROM SCREEN DTSCU011
|
|
00010 * DTSCU011
|
|
00011 * DTSCU011
|
|
00012 * MODIFICATION LOG: DTSCU011
|
|
00013 * DTSCU011
|
|
00014 * 08/03/98 INITIAL DEVELOPMENT MODIFIED FROM MACCU011. CL**2
|
|
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
|
00016 * DTSCU011
|
|
00017 * DTSCU011
|
|
00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU011
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU011
|
|
00020 * WORK ORDER: PROGRAMMER: DTSCU011
|
|
00021 * DTSCU011
|
|
00022 * DTSCU011
|
|
00023 * DTSCU011
|
|
00024 ***** DTSCU011
|
|
00025 SKIP3 DTSCU011
|
|
00026 ENVIRONMENT DIVISION. DTSCU011
|
|
00027 DATA DIVISION. DTSCU011
|
|
00028 SKIP3 DTSCU011
|
|
00029 WORKING-STORAGE SECTION. DTSCU011
|
|
000295 77 PAN-VALET PICTURE X(24) VALUE '006DTSCU011 09/22/98'. DTSCU011
|
|
00030 01 WRK-AREA. DTSCU011
|
|
00031 05 VALID-NUMBER-IND PIC X(01). DTSCU011
|
|
00032 05 NEGATIVE-FOUND-IND PIC X(01). DTSCU011
|
|
00033 05 WS-SUB PIC S9(04) COMP. DTSCU011
|
|
00034 05 IN-SUB PIC S9(04) COMP. DTSCU011
|
|
00035 05 WS-AREA PIC 9(18). DTSCU011
|
|
00036 LINKAGE SECTION. DTSCU011
|
|
00037 01 DFHCOMMAREA. DTSCU011
|
|
00038 ++INCLUDE DTSIL011 CL**4
|
|
00039 PROCEDURE DIVISION. DTSCU011
|
|
00040 INSPECT L011-S-AMT CONVERTING LOW-VALUE TO SPACE. DTSCU011
|
|
00041 SKIP2 DTSCU011
|
|
00042 IF L011-S-AMT = SPACES DTSCU011
|
|
00043 SET L011-NO-ENTRY TO TRUE CL**3
|
|
00044 MOVE ZERO TO L011-AMT DTSCU011
|
|
00045 GO TO INIT0199-GO-BACK. DTSCU011
|
|
00046 CL**2
|
|
00047 SET L011-VALID TO TRUE. CL**3
|
|
00048 MOVE +0 TO L011-AMT. CL**2
|
|
00049 MOVE 0 TO WS-AREA. CL**2
|
|
00050 MOVE 'N' TO VALID-NUMBER-IND. DTSCU011
|
|
00051 MOVE 'N' TO NEGATIVE-FOUND-IND. DTSCU011
|
|
00052 MOVE +19 TO WS-SUB. DTSCU011
|
|
00053 PERFORM P1000-LOOP THRU P1000-LOOP-EXIT CL**2
|
|
00054 VARYING IN-SUB FROM 18 BY -1 DTSCU011
|
|
00055 UNTIL IN-SUB < 1. DTSCU011
|
|
00056 IF L011-NOT-VALID DTSCU011
|
|
00057 GO TO INIT0199-GO-BACK. DTSCU011
|
|
00058 CL**2
|
|
00059 IF NEGATIVE-FOUND-IND = 'N' DTSCU011
|
|
00060 COMPUTE L011-AMT = WS-AREA / 100 DTSCU011
|
|
00061 ELSE DTSCU011
|
|
00062 COMPUTE L011-AMT = (WS-AREA / 100) * -1. DTSCU011
|
|
00063 CL**2
|
|
00064 IF (L011-MIN-AMT NOT < +0) AND CL**2
|
|
00065 (L011-AMT < +0) DTSCU011
|
|
00066 SET L011-INVALID-NEGATIVE TO TRUE CL**3
|
|
00067 ********SET L011-NOT-VALID TO TRUE CL**6
|
|
00068 GO TO INIT0199-GO-BACK. CL**2
|
|
00069 CL**2
|
|
00070 IF (L011-AMT < L011-MIN-AMT) OR CL**2
|
|
00071 (L011-AMT > L011-MAX-AMT) DTSCU011
|
|
00072 SET L011-EXCEEDS-MIN-MAX TO TRUE. CL**6
|
|
00073 ********SET L011-NOT-VALID TO TRUE. CL**6
|
|
00074 INIT0199-GO-BACK. DTSCU011
|
|
00075 EXEC CICS DTSCU011
|
|
00076 RETURN DTSCU011
|
|
00077 END-EXEC. DTSCU011
|
|
00078 GOBACK. DTSCU011
|
|
00079 P1000-LOOP. DTSCU011
|
|
00080 IF L011-S-AMT (IN-SUB : 1) = SPACES OR CL**2
|
|
00081 L011-S-AMT (IN-SUB : 1) = LOW-VALUES OR CL**5
|
|
00082 L011-S-AMT (IN-SUB : 1) = ',' OR CL**5
|
|
00083 L011-S-AMT (IN-SUB : 1) = '.' CL**2
|
|
00084 GO TO P1000-LOOP-EXIT. CL**2
|
|
00085 CL**2
|
|
00086 IF L011-S-AMT (IN-SUB : 1) = '-' DTSCU011
|
|
00087 IF NEGATIVE-FOUND-IND = 'Y' CL**2
|
|
00088 SET L011-NOT-NUMERIC TO TRUE CL**3
|
|
00089 ***********SET L011-NOT-VALID TO TRUE CL**6
|
|
00090 GO TO P1000-LOOP-EXIT CL**2
|
|
00091 ELSE DTSCU011
|
|
00092 MOVE 'Y' TO NEGATIVE-FOUND-IND DTSCU011
|
|
00093 GO TO P1000-LOOP-EXIT. CL**2
|
|
00094 CL**2
|
|
00095 IF L011-S-AMT (IN-SUB : 1) NUMERIC DTSCU011
|
|
00096 SUBTRACT 1 FROM WS-SUB DTSCU011
|
|
00097 MOVE L011-S-AMT (IN-SUB : 1) TO WS-AREA (WS-SUB : 1) DTSCU011
|
|
00098 MOVE 'Y' TO VALID-NUMBER-IND DTSCU011
|
|
00099 ELSE DTSCU011
|
|
00100 SET L011-NOT-NUMERIC TO TRUE. CL**6
|
|
00101 *********SET L011-NOT-VALID TO TRUE. CL**6
|
|
00102 P1000-LOOP-EXIT. EXIT. CL**2
|