giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
f4842b4a6fc0b09529f4d6ee98f1e13045d95690
DUTAS/CICS/DTSCU023.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

154 lines
12 KiB
COBOL
Raw Blame History

00001 IDENTIFICATION DIVISION. 09/23/98
00002 PROGRAM-ID. DTSCU023 DTSCU023
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008
00004 DATE-WRITTEN SEPTEMBER 1998. CL**2
00005 DATE-COMPILED. DTSCU023
00006 SKIP3 DTSCU023
00007 ***** DTSCU023
00008 * DTSCU023
00009 * FUNCTION: EDIT AND FORMAT RESERVE RATIOS FROM SCREEN CL**2
00010 * DTSCU023
00011 * DTSCU023
00012 * MODIFICATION LOG: DTSCU023
00013 * DTSCU023
00014 * 09/11/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCU023 CL**2
00015 * WORK ORDER: PROGRAMMER: GD CL**2
00016 * DTSCU023
00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**2
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU023
00019 * WORK ORDER: PROGRAMMER: DTSCU023
00020 * DTSCU023
00021 * DTSCU023
00022 * DESCRIPTION: RESERVE RATIOS ENTERED ON THE SCREEN MUST BE CL**5
00023 * NUMERIC IN THE --9.9. THE MAXIMUM RATION MUST CL**5
00024 * BE GREATER THAN THE MINIMUM RATIO. BOTH THE CL**5
00025 * MAXIMUM AND MINIMUM RATIOS MUST BE ENTERED. CL**5
00026 * DTSCU023
00027 ***** DTSCU023
00028 SKIP3 DTSCU023
00029 ENVIRONMENT DIVISION. DTSCU023
00030 DATA DIVISION. DTSCU023
00031 SKIP3 DTSCU023
00032 WORKING-STORAGE SECTION. DTSCU023
000325 77 PAN-VALET PICTURE X(24) VALUE '008DTSCU023 09/23/98'. DTSCU023
00033 01 WORKING-STORAGE-AREA. DTSCU023
00034 05 WS-DECIMAL-FOUND-IND PIC X(01). DTSCU023
00035 88 WS-DECIMAL-NOT-FOUND VALUE '0'. DTSCU023
00036 88 WS-DECIMAL-FOUND VALUE '1'. DTSCU023
00037 05 WS-NEGATIVE-FOUND-IND PIC X(01). DTSCU023
00038 88 WS-NEGATIVE-NOT-FOUND VALUE '0'. DTSCU023
00039 88 WS-NEGATIVE-FOUND VALUE '1'. DTSCU023
00040 05 WS-DIGIT-CTR PIC S9(04) COMP. DTSCU023
00041 05 WS-SUB PIC S9(04) COMP. DTSCU023
00042 05 IN-SUB PIC S9(04) COMP. DTSCU023
00043 05 WS-AREA PIC 9(03). CL**2
00044 05 WS-RATIO PIC X(05). CL**2
00045 05 DUMMY PIC X(01). DTSCU023
00046 LINKAGE SECTION. DTSCU023
00047 01 DFHCOMMAREA. DTSCU023
00048 ++INCLUDE DTSIL023 CL**2
00049 EJECT DTSCU023
00050 PROCEDURE DIVISION. DTSCU023
00051 SET L023-VALID TO TRUE. DTSCU023
00052 SET L023-MIN-VALID TO TRUE. DTSCU023
00053 MOVE +0 TO L023-MIN-RATIO DTSCU023
00054 L023-MAX-RATIO. DTSCU023
00055 SKIP1 DTSCU023
00056 INSPECT L023-S-MIN-RATIO CONVERTING LOW-VALUE TO SPACE. DTSCU023
00057 INSPECT L023-S-MAX-RATIO CONVERTING LOW-VALUE TO SPACE. DTSCU023
00058 SKIP1 DTSCU023
00059 IF L023-S-MIN-RATIO = SPACE CL**2
00060 SET L023-MIN-NOT-VALID TO TRUE CL**2
00061 SET L023-NO-MIN-ENTRY TO TRUE. CL**8
00062 CL**2
00063 IF L023-S-MAX-RATIO = SPACE CL**2
00064 IF L023-NO-MIN-ENTRY CL**8
00065 SET L023-NO-MIN-MAX-ENTRY TO TRUE CL**8
00066 GO TO INIT0199-GO-BACK CL**6
00067 ELSE CL**6
00068 SET L023-NO-MAX-ENTRY TO TRUE. CL**8
00069 IF L023-NO-MIN-ENTRY CL**7
00070 OR L023-NO-MAX-ENTRY CL**7
00071 GO TO INIT0199-GO-BACK. CL**7
00072 SKIP3 DTSCU023
00073 MOVE 0 TO WS-AREA DTSCU023
00074 WS-DIGIT-CTR. DTSCU023
00075 SET WS-NEGATIVE-NOT-FOUND TO TRUE. DTSCU023
00076 SET WS-DECIMAL-NOT-FOUND TO TRUE. DTSCU023
00077 MOVE +4 TO WS-SUB. CL**2
00078 MOVE L023-S-MIN-RATIO TO WS-RATIO. DTSCU023
00079 PERFORM P1000-LOOP THRU P1000-EXIT DTSCU023
00080 VARYING IN-SUB FROM +5 BY -1 CL**2
00081 UNTIL IN-SUB < 1. DTSCU023
00082 IF WS-DECIMAL-NOT-FOUND DTSCU023
00083 SET L023-NOT-VALID TO TRUE. DTSCU023
00084 IF NOT L023-VALID DTSCU023
00085 SET L023-MIN-NOT-VALID TO TRUE DTSCU023
00086 GO TO INIT0199-GO-BACK. DTSCU023
00087 IF WS-NEGATIVE-FOUND DTSCU023
00088 COMPUTE L023-MIN-RATIO = (WS-AREA / 1000) * -1 CL**2
00089 ELSE DTSCU023
00090 COMPUTE L023-MIN-RATIO = WS-AREA / 1000. CL**2
00091 SKIP1 DTSCU023
00092 MOVE 0 TO WS-AREA DTSCU023
00093 WS-DIGIT-CTR. DTSCU023
00094 SET WS-NEGATIVE-NOT-FOUND TO TRUE. DTSCU023
00095 SET WS-DECIMAL-NOT-FOUND TO TRUE. DTSCU023
00096 MOVE +4 TO WS-SUB. CL**2
00097 MOVE L023-S-MAX-RATIO TO WS-RATIO. DTSCU023
00098 PERFORM P1000-LOOP THRU P1000-EXIT DTSCU023
00099 VARYING IN-SUB FROM +5 BY -1 CL**2
00100 UNTIL IN-SUB < 1. DTSCU023
00101 IF WS-DECIMAL-NOT-FOUND DTSCU023
00102 SET L023-NOT-VALID TO TRUE. DTSCU023
00103 IF NOT L023-VALID DTSCU023
00104 GO TO INIT0199-GO-BACK. DTSCU023
00105 IF WS-NEGATIVE-FOUND DTSCU023
00106 COMPUTE L023-MAX-RATIO = (WS-AREA / 1000) * -1 CL**2
00107 ELSE DTSCU023
00108 COMPUTE L023-MAX-RATIO = WS-AREA / 1000. CL**2
00109 SKIP3 DTSCU023
00110 IF L023-MIN-RATIO > L023-MAX-RATIO DTSCU023
00111 SET L023-CROSS-EDIT-ERROR TO TRUE. DTSCU023
00112 SKIP1 DTSCU023
00113 INIT0199-GO-BACK. DTSCU023
00114 EXEC CICS DTSCU023
00115 RETURN DTSCU023
00116 END-EXEC. DTSCU023
00117 GOBACK. DTSCU023
00118 P1000-LOOP. DTSCU023
00119 IF WS-RATIO (IN-SUB : 1) = SPACE DTSCU023
00120 GO TO P1000-EXIT. DTSCU023
00121 SKIP1 DTSCU023
00122 IF WS-RATIO (IN-SUB : 1) = '.' DTSCU023
00123 IF WS-DECIMAL-FOUND DTSCU023
00124 SET L023-NOT-VALID TO TRUE DTSCU023
00125 ELSE DTSCU023
00126 IF WS-DIGIT-CTR = +1 CL**2
00127 SET WS-DECIMAL-FOUND TO TRUE DTSCU023
00128 ELSE DTSCU023
00129 SET L023-NOT-VALID TO TRUE DTSCU023
00130 END-IF DTSCU023
00131 GO TO P1000-EXIT. DTSCU023
00132 SKIP1 DTSCU023
00133 IF WS-RATIO (IN-SUB : 1) = '-' DTSCU023
00134 IF WS-NEGATIVE-FOUND DTSCU023
00135 *********OR WS-DIGIT-CTR > +0 DTSCU023
00136 SET L023-NOT-VALID TO TRUE DTSCU023
00137 ELSE DTSCU023
00138 SET WS-NEGATIVE-FOUND TO TRUE DTSCU023
00139 END-IF DTSCU023
00140 GO TO P1000-EXIT. DTSCU023
00141 SKIP1 DTSCU023
00142 IF WS-RATIO (IN-SUB : 1) NUMERIC DTSCU023
00143 ADD +1 TO WS-DIGIT-CTR DTSCU023
00144 IF WS-DIGIT-CTR > 3 CL**2
00145 SET L023-EXCEEDS-MIN-MAX TO TRUE DTSCU023
00146 ELSE DTSCU023
00147 SUBTRACT +1 FROM WS-SUB DTSCU023
00148 MOVE WS-RATIO (IN-SUB : 1) TO WS-AREA (WS-SUB : 1) DTSCU023
00149 ELSE DTSCU023
00150 SET L023-NOT-VALID TO TRUE. DTSCU023
00151 P1000-EXIT. DTSCU023
00152 EXIT. DTSCU023
Reference in New Issue View Git Blame Copy Permalink