74 lines
5.7 KiB
COBOL
74 lines
5.7 KiB
COBOL
00001 ***** 08/31/98
|
|
00002 * DTSIP007
|
|
00003 * DTSIP007 RECORD EXPANSION PROCEDURE DIVISION CODE. LV002
|
|
00004 * DTSIP007
|
|
00005 * IF THIS CODE IS MODIFIED, THEN DTSCU810 CL**2
|
|
00006 * AND DTSBU910 MUST BE RECOMPILED. CL**2
|
|
00007 * DTSIP007
|
|
00008 * CL**2
|
|
00009 * 08/31/1998 REVIEWED AND MODIFIED FOR DC. EHH CL**2
|
|
00010 * CL**2
|
|
00011 ***** DTSIP007
|
|
00012 CL**2
|
|
00013 S7000-IO-DATA-TO-WRK-DATA.
|
|
*** SET MIO-COMPRESS-NO-88 TO TRUE. DTSIP007
|
|
00014 IF MIO-COMPRESS-NO-88 DTSIP007
|
|
00015 PERFORM S7100-EXPAND-NO THRU S7100-EXIT DTSIP007
|
|
00016 ELSE DTSIP007
|
|
00017 IF MIO-COMPRESS-1-88 DTSIP007
|
|
00018 PERFORM S7200-EXPAND-1 THRU S7200-EXIT DTSIP007
|
|
00019 ELSE DTSIP007
|
|
00020 PERFORM S899-ABEND THRU S899-EXIT. DTSIP007
|
|
00021 S7000-EXIT. DTSIP007
|
|
00022 EXIT. DTSIP007
|
|
00023 EJECT DTSIP007
|
|
00024 S7100-EXPAND-NO. DTSIP007
|
|
00025 MOVE MIO-DATA-AREA (1:MIO-DATA-LENGTH) DTSIP007
|
|
00026 TO WRK-DATA-AREA (1:MIO-DATA-LENGTH). DTSIP007
|
|
00027 MOVE MIO-DATA-LENGTH TO WRK-DATA-LENGTH. DTSIP007
|
|
00028 S7100-EXIT. DTSIP007
|
|
00029 EXIT. DTSIP007
|
|
00030 EJECT DTSIP007
|
|
00031 S7200-EXPAND-1. DTSIP007
|
|
00032 MOVE LOW-VALUES TO WRK-DATA-AREA. DTSIP007
|
|
00033 MOVE +1 TO WRK-DATA-LENGTH. DTSIP007
|
|
00034 SET MIO-DATA-IDX TO +1. DTSIP007
|
|
00035 PERFORM S7210-EXPAND-1-LOOP THRU S7210-EXIT DTSIP007
|
|
00036 UNTIL MIO-DATA-IDX > MIO-DATA-LENGTH. DTSIP007
|
|
00037 SUBTRACT 1 FROM WRK-DATA-LENGTH. DTSIP007
|
|
00038 S7200-EXIT. DTSIP007
|
|
00039 EXIT. DTSIP007
|
|
00040 SKIP3 DTSIP007
|
|
00041 S7210-EXPAND-1-LOOP. DTSIP007
|
|
00042 MOVE +0 TO CMP-BINARY-HALF-WORD. DTSIP007
|
|
00043 CL**2
|
|
00044 MOVE MIO-DATA-CHAR (MIO-DATA-IDX) TO CMP-BINARY-HALF-BYTE-2. DTSIP007
|
|
00045 CL**2
|
|
00046 IF CMP-BINARY-HALF-BYTE-2 < CMP-LOW-VALUES-BYTE DTSIP007
|
|
00047 MOVE CMP-BINARY-HALF-WORD TO CMP-STRING-LENGTH DTSIP007
|
|
00048 SET CMP-SUB-S1 TO MIO-DATA-IDX DTSIP007
|
|
00049 ADD +1 TO CMP-SUB-S1 DTSIP007
|
|
00050 MOVE MIO-DATA-AREA (CMP-SUB-S1:CMP-STRING-LENGTH) DTSIP007
|
|
00051 TO WRK-DATA-AREA (WRK-DATA-LENGTH:CMP-STRING-LENGTH) DTSIP007
|
|
00052 ADD CMP-STRING-LENGTH TO WRK-DATA-LENGTH DTSIP007
|
|
00053 SET MIO-DATA-IDX UP BY CMP-STRING-LENGTH DTSIP007
|
|
00054 ELSE DTSIP007
|
|
00055 IF CMP-BINARY-HALF-BYTE-2 < CMP-PACKED-ZERO-BYTE DTSIP007
|
|
00056 COMPUTE CMP-STRING-LENGTH = CMP-BINARY-HALF-WORD - 64 DTSIP007
|
|
00057 ADD CMP-STRING-LENGTH TO WRK-DATA-LENGTH DTSIP007
|
|
00058 ELSE DTSIP007
|
|
00059 IF CMP-BINARY-HALF-BYTE-2 < CMP-SPACES-BYTE DTSIP007
|
|
00060 COMPUTE CMP-STRING-LENGTH = CMP-BINARY-HALF-WORD - 128 DTSIP007
|
|
00061 ADD CMP-STRING-LENGTH TO WRK-DATA-LENGTH DTSIP007
|
|
00062 MOVE CMP-PACKED-ZERO-LIT DTSIP007
|
|
00063 TO WRK-DATA-CHAR (WRK-DATA-LENGTH - 1) DTSIP007
|
|
00064 ELSE DTSIP007
|
|
00065 COMPUTE CMP-STRING-LENGTH = CMP-BINARY-HALF-WORD - 192 DTSIP007
|
|
00066 MOVE SPACES DTSIP007
|
|
00067 TO WRK-DATA-AREA (WRK-DATA-LENGTH:CMP-STRING-LENGTH) DTSIP007
|
|
00068 ADD CMP-STRING-LENGTH TO WRK-DATA-LENGTH. DTSIP007
|
|
00069 CL**2
|
|
00070 SET MIO-DATA-IDX UP BY 1. DTSIP007
|
|
00071 S7210-EXIT. DTSIP007
|
|
00072 EXIT. DTSIP007
|