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