DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
103
CICS/DTSCU011.cob
Normal file
103
CICS/DTSCU011.cob
Normal file
@ -0,0 +1,103 @@
|
||||
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
|
||||
Reference in New Issue
Block a user