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

72
Copybook/DTSIP007.cpy Normal file
View File

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