enrico-sorichetti
Superior Member
Joined: 14 Mar 2007
Posts: 10888
Location: italy
|
|
|
|
here is an edit macro for .... ( see the topic title )
| Code: |
****** ***************************** Top of Data ******************************
000001 /*REXX - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
000002 /* */
000003 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
000004 Trace "O"
000005 Parse Source _sys _how _cmd .
000006 If Sysvar(SYSISPF) \= "ACTIVE" Then Do
000007 Say left(_cmd,8)"- Ispf is not active. Command not executed"
000008 exit 4
000009 End
000010 call $ispex "CONTROL ERRORS RETURN"
000011 if 0 \= $isred("MACRO (ARGS) NOPROCESS ") then do
000012 zedsmsg = "Invocation ERROR"
000013 zedlmsg = left(_cmd,8)"- Must invoked as a MACRO"
000014 call $ispex "SETMSG MSG(ISRZ001)"
000015 exit 4
000016 end
000017 args = space(args)
000018 argc = words(args)
000019
000020 TRKCAP = 56664
000021 MAXREC = 32760
000022 MAXBLK = 27998
000023 MAXBLK2 = 27648
000024 MAXKEY = 256
000025
000026 WHATLINE = "DATALINE"
000027 WHERE = "LINE_AFTER .ZLAST"
000028 call $isred("DOWN MAX")
000029
000030 WHATLINE = "NOTELINE"
000031 WHERE = "LINE_BEFORE .ZFIRST"
000032 call $isred("UP MAX")
000033
000034 if argc = 0 | argc > 2 then do
000035 zedsmsg = left(_cmd,8)"- Args error"
000036 zedlmsg = left(_cmd,8)"- Arguments missing or invalid"
000037 call $ispex "SETMSG MSG(ISRZ001)"
000038 Exit 4
000039 end
000040 parse var args reclen keylen
000041 reclen = strip(reclen)
000042 keylen = strip(keylen)
000043 if keylen = "" then ,
000044 keylen = 0
000045
000046 if datatype(reclen) \= "NUM" | ,
000047 datatype(keylen) \= "NUM" then do
000048 zedsmsg = left(_cmd,8)"- Type error"
000049 zedlmsg = left(_cmd,8)"- Arguments must be numeric"
000050 call $ispex "SETMSG MSG(ISRZ001)"
000051 Exit 4
000052 end
000053
000054 if reclen > MAXREC then do
000055 zedsmsg = left(_cmd,8)"- RECLEN error"
000056 zedlmsg = left(_cmd,8)"- Record length greater than " MAXREC
000057 call $ispex "SETMSG MSG(ISRZ001)"
000058 Exit 4
000059 end
000060
000061 if keylen > MAXKEY then do
000062 zedsmsg = left(_cmd,8)"- KEYLEN error"
000063 zedlmsg = left(_cmd,8)"- Key length greater than " MAXKEY
000064 call $ispex "SETMSG MSG(ISRZ001)"
000065 Exit 4
000066 end
000067
000068 c_blksz = reclen
000069 c_count = blksxtrk(c_blksz,keylen)
000070 i_blksz = c_blksz
000071 i_count = c_count
000072 p_blksz = c_blksz
000073 p_count = c_count
000074 buff = ""
000075 if keylen \= 0 then ,
000076 buff = buff || right("keylen",8)
000077 buff = buff || " " || right("lrecl",8)
000078 buff = buff || " " || right("m-blksz",8)
000079 buff = buff || " " || right("M-blksz",8)
000080 buff = buff || " " || right("blocks",8)
000081 buff = buff || " " || right("m-recs",8)
000082 buff = buff || " " || right("M_recs",8)
000083 call $isred WHERE " = " WHATLINE " (BUFF)"
000084 do i = reclen to MAXBLK*(keylen=0) + MAXBLK2*(keylen>0) by reclen
000085 c_blksz = i
000086 c_count = blksxtrk(c_blksz,keylen)
000087 if c_count \= p_count then do
000088 buff = ""
000089 if keylen \= 0 then ,
000090 buff = buff || right(keylen,8)
000091 buff = buff || " " || right(reclen ,8)
000092 buff = buff || " " || right(i_blksz ,8)
000093 buff = buff || " " || right(p_blksz ,8)
000094 buff = buff || " " || right(p_count ,8)
000095 buff = buff || " " || right(p_count*(i_blksz/reclen), 8)
000096 buff = buff || " " || right(p_count*(p_blksz/reclen), 8)
000097 i_blksz = c_blksz
000098 i_count = c_count
000099 call $isred WHERE " = " WHATLINE " (BUFF)"
000100 end
000101 p_blksz = c_blksz
000102 p_count = c_count
000103 end
000104 buff = ""
000105 if keylen \= 0 then ,
000106 buff = buff || right(keylen,8)
000107 buff = buff || " " || right(reclen ,8)
000108 buff = buff || " " || right(i_blksz ,8)
000109 buff = buff || " " || right(p_blksz ,8)
000110 buff = buff || " " || right(p_count ,8)
000111 buff = buff || " " || right(p_count*(i_blksz/reclen), 8)
000112 buff = buff || " " || right(p_count*(p_blksz/reclen), 8)
000113 call $isred WHERE " = " WHATLINE " (BUFF)"
000114
000115 zedsmsg = left(_cmd,8)"- Ended"
000116 zedlmsg = "Execution of "left(_cmd,8)" ended "
000117 call $ispex "SETMSG MSG(ISRZ001)"
000118
000119 Exit 0
000120
000121 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
000122 blksxtrk:procedure
000123 parse arg blksz, keyln
000124 c = 10
000125 if keylen = 0 then ,
000126 k = 0
000127 else do
000128 kn = (keyln+6)%232+1-(((keyln+6)//232)=0)
000129 k = 9+(keyln+6*kn+6)%34+1-(((keyln+6*kn+6)//34)=0)
000130 end
000131 dn = (blksz+6)%232+1-(((blksz+6)//232)=0)
000132 d = 9+(blksz+6*dn+6)%34+1-(((blksz+6*dn+6)//34)=0)
000133 s = c+k+d
000134 return 1729 % s
000135
000136 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
000137 $ispex:
000138 isp_tr = trace("O")
000139 Address ISPEXEC arg(1)
000140 isp_rc = rc
000141 trace value(isp_tr)
000142 return isp_rc
000143 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
000144 $isred:
000145 isr_tr = trace("O")
000146 Address ISREDIT arg(1)
000147 isr_rc = rc
000148 trace value(isr_tr)
000149 return isr_rc
000150
****** **************************** Bottom of Data ****************************
|
save it in a pds in Your SYSPROC/SYSEXEC concatenation with a name of Your choice
the macro takes 2 arguments record length and key length ( the second one can be omitted )
when the macro is run with a record length of 1 it will reproduce the manual table!
the table is displayed as NOTELINES at the top of the member being edited
if somembody prefers, switching the three lines at line 26 with the three lines at line 30
it will insert the table as datalines at the bottom of the member being edited
here is the link to the same as a REXX script for the PC
www.ibmmainframes.com/viewtopic.php?t=35906&postdays=0&postorder=asc&start=15 |
|
