Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

(Blocks x Track calculator ) ISPF Edit macro

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> TSO/ISPF
View previous topic :: :: View next topic  
Author Message
enrico-sorichetti

Global Moderator


Joined: 14 Mar 2007
Posts: 10272
Location: italy

PostPosted: Tue Jun 21, 2011 1:32 pm    Post subject: (Blocks x Track calculator ) ISPF Edit macro
Reply with quote

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
http://www.ibmmainframes.com/viewtopic.php?t=35906&postdays=0&postorder=asc&start=15
Back to top
View user's profile Send private message

View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> TSO/ISPF All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts RC 20 for Address ISPEXEC "ISRED... pkmurali CLIST & REXX 3 Sun Apr 16, 2017 11:30 pm
No new posts Edit large number of datasets (QSAM) zh_lad TSO/ISPF 3 Tue Apr 04, 2017 6:08 pm
No new posts Receive a file using PCOMM macro Harald.v.K IBM Tools 0 Thu Mar 23, 2017 6:50 pm
No new posts Customizing the ISPF HILITE Command Pedro TSO/ISPF 3 Fri Mar 03, 2017 11:49 pm
No new posts Mass comment and edit elixir1986 IBM Tools 3 Thu Mar 02, 2017 10:09 pm


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us