DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
188
Copybook/DTSIP006.cpy
Normal file
188
Copybook/DTSIP006.cpy
Normal file
@ -0,0 +1,188 @@
|
||||
00001 ***** 08/31/98
|
||||
00002 * DTSIP006
|
||||
00003 * DTSIP006 RECORD COMPRESSION PROCEDURE DIVISION CODE. LV002
|
||||
00004 * DTSIP006
|
||||
00005 * IF THIS CODE IS MODIFIED, THEN DTSCU810 CL**2
|
||||
00006 * AND DTSBU910 MUST BE RECOMPILED. CL**2
|
||||
00007 * DTSIP006
|
||||
00008 * CL**2
|
||||
00009 * 08/31/1998 REVIEWED AND MODIFIED FOR DC. EHH CL**2
|
||||
00010 * CL**2
|
||||
00011 ***** DTSIP006
|
||||
00012 CL**2
|
||||
00013 S6000-WRK-DATA-TO-IO-DATA. DTSIP006
|
||||
00014 IF MLEN-COMPRESS-NO-88 (REC-TYPE-SUB) DTSIP006
|
||||
00015 PERFORM S6100-COMPRESS-NO THRU S6100-EXIT DTSIP006
|
||||
00016 ELSE DTSIP006
|
||||
00017 IF MLEN-COMPRESS-1-88 (REC-TYPE-SUB) DTSIP006
|
||||
00018 PERFORM S6200-COMPRESS-1 THRU S6200-EXIT DTSIP006
|
||||
00019 ELSE DTSIP006
|
||||
00020 PERFORM S899-ABEND THRU S899-EXIT. DTSIP006
|
||||
00021 S6000-EXIT. DTSIP006
|
||||
00022 EXIT. DTSIP006
|
||||
00023 EJECT DTSIP006
|
||||
00024 S6100-COMPRESS-NO. DTSIP006
|
||||
00025 MOVE WRK-DATA-AREA (1:WRK-DATA-LENGTH) DTSIP006
|
||||
00026 TO MIO-DATA-AREA (1:WRK-DATA-LENGTH). DTSIP006
|
||||
00027 MOVE WRK-DATA-LENGTH TO MIO-DATA-LENGTH. DTSIP006
|
||||
00028 SET MIO-COMPRESS-NO-88 TO TRUE. DTSIP006
|
||||
00029 S6100-EXIT. DTSIP006
|
||||
00030 EXIT. DTSIP006
|
||||
00031 EJECT DTSIP006
|
||||
00032 S6200-COMPRESS-1. DTSIP006
|
||||
00033 MOVE +1 TO MIO-DATA-LENGTH. DTSIP006
|
||||
00034 MOVE +1 TO CMP-SUB-S1. DTSIP006
|
||||
00035 PERFORM S6210-COMPRESS-1-LOOP THRU S6210-EXIT DTSIP006
|
||||
00036 UNTIL CMP-SUB-S1 > WRK-DATA-LENGTH. DTSIP006
|
||||
00037 SUBTRACT 1 FROM MIO-DATA-LENGTH. DTSIP006
|
||||
00038 IF MIO-DATA-LENGTH < WRK-DATA-LENGTH DTSIP006
|
||||
00039 SET MIO-COMPRESS-1-88 TO TRUE DTSIP006
|
||||
00040 ELSE DTSIP006
|
||||
00041 PERFORM S6100-COMPRESS-NO THRU S6100-EXIT. DTSIP006
|
||||
00042 S6200-EXIT. DTSIP006
|
||||
00043 EXIT. DTSIP006
|
||||
00044 SKIP3 DTSIP006
|
||||
00045 S6210-COMPRESS-1-LOOP. DTSIP006
|
||||
00046 MOVE CMP-SUB-S1 TO CMP-SUB-S2. DTSIP006
|
||||
00047 MOVE +0 TO CMP-STRING-LENGTH. DTSIP006
|
||||
00048 MOVE 'N' TO CMP-STRING-COMPLETE-IND. DTSIP006
|
||||
00049 CL**2
|
||||
00050 IF WRK-DATA-CHAR (CMP-SUB-S2) = SPACES DTSIP006
|
||||
00051 PERFORM S6220-SPACE-STRING THRU S6220-EXIT DTSIP006
|
||||
00052 UNTIL CMP-STRING-COMPLETE-IND = 'Y' DTSIP006
|
||||
00053 ELSE DTSIP006
|
||||
00054 IF WRK-DATA-CHAR (CMP-SUB-S2) = LOW-VALUES DTSIP006
|
||||
00055 PERFORM S6230-LOW-VALUES-STRING THRU S6230-EXIT DTSIP006
|
||||
00056 UNTIL CMP-STRING-COMPLETE-IND = 'Y' DTSIP006
|
||||
00057 ELSE DTSIP006
|
||||
00058 PERFORM S6240-ACTUAL-VALUES-STRING THRU S6240-EXIT DTSIP006
|
||||
00059 UNTIL CMP-STRING-COMPLETE-IND = 'Y'. DTSIP006
|
||||
00060 CL**2
|
||||
00061 ADD CMP-STRING-LENGTH TO CMP-SUB-S1. DTSIP006
|
||||
00062 S6210-EXIT. DTSIP006
|
||||
00063 EXIT. DTSIP006
|
||||
00064 SKIP3 DTSIP006
|
||||
00065 S6220-SPACE-STRING. DTSIP006
|
||||
00066 ADD +1 TO CMP-STRING-LENGTH. DTSIP006
|
||||
00067 CL**2
|
||||
00068 IF CMP-STRING-LENGTH NOT < CMP-STRING-MAX DTSIP006
|
||||
00069 PERFORM S6221-SPACE THRU S6221-EXIT DTSIP006
|
||||
00070 GO TO S6220-EXIT. DTSIP006
|
||||
00071 CL**2
|
||||
00072 ADD +1 TO CMP-SUB-S2. DTSIP006
|
||||
00073 CL**2
|
||||
00074 IF CMP-SUB-S2 > WRK-DATA-LENGTH DTSIP006
|
||||
00075 PERFORM S6221-SPACE THRU S6221-EXIT DTSIP006
|
||||
00076 GO TO S6220-EXIT. DTSIP006
|
||||
00077 CL**2
|
||||
00078 IF WRK-DATA-CHAR (CMP-SUB-S2) = SPACE DTSIP006
|
||||
00079 NEXT SENTENCE DTSIP006
|
||||
00080 ELSE DTSIP006
|
||||
00081 PERFORM S6221-SPACE THRU S6221-EXIT. DTSIP006
|
||||
00082 S6220-EXIT. DTSIP006
|
||||
00083 EXIT. DTSIP006
|
||||
00084 CL**2
|
||||
00085 S6221-SPACE. DTSIP006
|
||||
00086 MOVE +0 TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00087 MOVE CMP-SPACES-BYTE TO CMP-BINARY-HALF-BYTE-2. DTSIP006
|
||||
00088 ADD CMP-STRING-LENGTH TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00089 MOVE CMP-BINARY-HALF-BYTE-2 DTSIP006
|
||||
00090 TO MIO-DATA-CHAR (MIO-DATA-LENGTH). DTSIP006
|
||||
00091 ADD +1 TO MIO-DATA-LENGTH. DTSIP006
|
||||
00092 CL**2
|
||||
00093 MOVE 'Y' TO CMP-STRING-COMPLETE-IND. DTSIP006
|
||||
00094 S6221-EXIT. DTSIP006
|
||||
00095 EXIT. DTSIP006
|
||||
00096 SKIP3 DTSIP006
|
||||
00097 S6230-LOW-VALUES-STRING. DTSIP006
|
||||
00098 ADD +1 TO CMP-STRING-LENGTH. DTSIP006
|
||||
00099 CL**2
|
||||
00100 IF CMP-STRING-LENGTH NOT < CMP-STRING-MAX DTSIP006
|
||||
00101 PERFORM S6231-LOW-VALUES THRU S6231-EXIT DTSIP006
|
||||
00102 GO TO S6230-EXIT. DTSIP006
|
||||
00103 CL**2
|
||||
00104 ADD +1 TO CMP-SUB-S2. DTSIP006
|
||||
00105 CL**2
|
||||
00106 IF CMP-SUB-S2 > WRK-DATA-LENGTH DTSIP006
|
||||
00107 PERFORM S6231-LOW-VALUES THRU S6231-EXIT DTSIP006
|
||||
00108 GO TO S6230-EXIT. DTSIP006
|
||||
00109 CL**2
|
||||
00110 IF WRK-DATA-CHAR (CMP-SUB-S2) = LOW-VALUES DTSIP006
|
||||
00111 NEXT SENTENCE DTSIP006
|
||||
00112 ELSE DTSIP006
|
||||
00113 IF WRK-DATA-CHAR (CMP-SUB-S2) = CMP-PACKED-ZERO-LIT DTSIP006
|
||||
00114 ADD +1 TO CMP-STRING-LENGTH DTSIP006
|
||||
00115 PERFORM S6232-PACKED-ZERO THRU S6232-EXIT DTSIP006
|
||||
00116 ELSE DTSIP006
|
||||
00117 PERFORM S6231-LOW-VALUES THRU S6231-EXIT. DTSIP006
|
||||
00118 S6230-EXIT. DTSIP006
|
||||
00119 EXIT. DTSIP006
|
||||
00120 CL**2
|
||||
00121 S6231-LOW-VALUES. DTSIP006
|
||||
00122 MOVE +0 TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00123 MOVE CMP-LOW-VALUES-BYTE TO CMP-BINARY-HALF-BYTE-2. DTSIP006
|
||||
00124 ADD CMP-STRING-LENGTH TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00125 MOVE CMP-BINARY-HALF-BYTE-2 DTSIP006
|
||||
00126 TO MIO-DATA-CHAR (MIO-DATA-LENGTH). DTSIP006
|
||||
00127 ADD +1 TO MIO-DATA-LENGTH. DTSIP006
|
||||
00128 CL**2
|
||||
00129 MOVE 'Y' TO CMP-STRING-COMPLETE-IND. DTSIP006
|
||||
00130 S6231-EXIT. DTSIP006
|
||||
00131 EXIT. DTSIP006
|
||||
00132 CL**2
|
||||
00133 S6232-PACKED-ZERO. DTSIP006
|
||||
00134 MOVE +0 TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00135 MOVE CMP-PACKED-ZERO-BYTE TO CMP-BINARY-HALF-BYTE-2. DTSIP006
|
||||
00136 ADD CMP-STRING-LENGTH TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00137 MOVE CMP-BINARY-HALF-BYTE-2 DTSIP006
|
||||
00138 TO MIO-DATA-CHAR (MIO-DATA-LENGTH). DTSIP006
|
||||
00139 ADD +1 TO MIO-DATA-LENGTH. DTSIP006
|
||||
00140 CL**2
|
||||
00141 MOVE 'Y' TO CMP-STRING-COMPLETE-IND. DTSIP006
|
||||
00142 S6232-EXIT. DTSIP006
|
||||
00143 EXIT. DTSIP006
|
||||
00144 SKIP3 DTSIP006
|
||||
00145 S6240-ACTUAL-VALUES-STRING. DTSIP006
|
||||
00146 ADD +1 TO CMP-STRING-LENGTH. DTSIP006
|
||||
00147 CL**2
|
||||
00148 IF CMP-STRING-LENGTH NOT < CMP-STRING-MAX DTSIP006
|
||||
00149 PERFORM S6241-ACTUAL-VALUES THRU S6241-EXIT DTSIP006
|
||||
00150 GO TO S6240-EXIT. DTSIP006
|
||||
00151 CL**2
|
||||
00152 ADD +1 TO CMP-SUB-S2. DTSIP006
|
||||
00153 CL**2
|
||||
00154 IF CMP-SUB-S2 > WRK-DATA-LENGTH DTSIP006
|
||||
00155 PERFORM S6241-ACTUAL-VALUES THRU S6241-EXIT DTSIP006
|
||||
00156 GO TO S6240-EXIT. DTSIP006
|
||||
00157 CL**2
|
||||
00158 IF WRK-DATA-CHAR (CMP-SUB-S2) = SPACES DTSIP006
|
||||
00159 IF WRK-DATA-CHAR (CMP-SUB-S2 + 1) = SPACES DTSIP006
|
||||
00160 PERFORM S6241-ACTUAL-VALUES THRU S6241-EXIT DTSIP006
|
||||
00161 ELSE DTSIP006
|
||||
00162 NEXT SENTENCE DTSIP006
|
||||
00163 ELSE DTSIP006
|
||||
00164 IF WRK-DATA-CHAR (CMP-SUB-S2) = LOW-VALUES DTSIP006
|
||||
00165 IF WRK-DATA-CHAR (CMP-SUB-S2 + 1) DTSIP006
|
||||
00166 = LOW-VALUES OR CMP-PACKED-ZERO-LIT DTSIP006
|
||||
00167 PERFORM S6241-ACTUAL-VALUES THRU S6241-EXIT DTSIP006
|
||||
00168 ELSE DTSIP006
|
||||
00169 NEXT SENTENCE DTSIP006
|
||||
00170 ELSE DTSIP006
|
||||
00171 NEXT SENTENCE. DTSIP006
|
||||
00172 S6240-EXIT. DTSIP006
|
||||
00173 EXIT. DTSIP006
|
||||
00174 CL**2
|
||||
00175 S6241-ACTUAL-VALUES. DTSIP006
|
||||
00176 MOVE +0 TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00177 MOVE CMP-ACTUAL-VALUES-BYTE TO CMP-BINARY-HALF-BYTE-2. DTSIP006
|
||||
00178 ADD CMP-STRING-LENGTH TO CMP-BINARY-HALF-WORD. DTSIP006
|
||||
00179 MOVE CMP-BINARY-HALF-BYTE-2 DTSIP006
|
||||
00180 TO MIO-DATA-CHAR (MIO-DATA-LENGTH). DTSIP006
|
||||
00181 ADD +1 TO MIO-DATA-LENGTH. DTSIP006
|
||||
00182 MOVE WRK-DATA-AREA (CMP-SUB-S1:CMP-STRING-LENGTH) DTSIP006
|
||||
00183 TO MIO-DATA-AREA (MIO-DATA-LENGTH:CMP-STRING-LENGTH). DTSIP006
|
||||
00184 ADD CMP-STRING-LENGTH TO MIO-DATA-LENGTH. DTSIP006
|
||||
00185 CL**2
|
||||
00186 MOVE 'Y' TO CMP-STRING-COMPLETE-IND. DTSIP006
|
||||
00187 S6241-EXIT. DTSIP006
|
||||
00188 EXIT. DTSIP006
|
||||
Reference in New Issue
Block a user