giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

DUTAS re-platformed to Raincode - Initial Source Code

Browse Source
This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
CICS/DTSCU012.cob Normal file
View File

@ -0,0 +1,99 @@
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