/*                                                              REXX

 SKEL     Run ISPF FTINCL using selected edit data

 Edit pds member, then issue command SKEL

 Line range can be selected by the S/SS line command(s).

 Excluded lines are, well, excluded.

 Principles of operation
 - allocate temp pds.
 - load edit data and store in temp pds member.
 - add temp pds to the front of the ISPSLIB concatenation.
 - allocate temp skeleton output dataset to libref ISPFILE.
 - run file-tailoring (FTINCL) from temp pds member with output to
   temp skeleton output dataset.
 - allocate temp edit dataset.
 - copy temp skeleton output dataset to temp edit dataset.
 - free temp skeleton output dataset to allow for file tailoring in
   other screens.
 - edit temp edit dataset.
 - free remaining temp dataset.

 Notes
 - The skeleton output libref ISPFILE is used shortly, this may
   interfere with other applications.

 History
  2022-07-25  Initial (much simplified version of SKELX)

 Author
  Willy Jensen
  mail: willy@harders-jensen.com
  web : http://harders-jensen.com

 */

 Address Ispexec "Control errors return"
 Address Isredit "MACRO NOPROCESS"
 Address Isredit
 "(orgdsn) = dataset"
 "(orgmbr) = member"
 $sklmbr   = 'ZZZZSKEL'
 ddlist    = ''
 dsopt1    = 'new delete tracks space(5,5) unit(sysda) blksize(0)'

 /* load selected data to stem */
 "PROCESS RANGE S"    /* detect range selection */
 if rc>4 then exit ispmsg('Range not set correctly by S line comands')
 if rc=0 then do      /* take selected                   */
   "(lr1) = linenum .zfrange"
   "(lr2) = linenum .zlrange"
 end
 else do
   "(lr1) = linenum .zfirst"
   "(lr2) = linenum .zlast"
 end
 parse value 0 lr1+0 lr2+0 with n lr1 lr2  /* drop leading zeroes */
 Do p=lr1 to lr2
   "(s) = xstatus (p)"
   if s='X' then iterate     /* excluded */
   "(l) = line (p)"
   n=n+1
   line.n=strip(l,'t')
 End
 line.0=n

 /* allocate work lib, make work member */
 address ispexec "qbaselib ispslib id(sl)"  /* get              */
 sl=word(translate(sl," ","',"),1)          /*  ISPSLIB         */
 cc=listdsi("'"sl"'")                       /*   specs -        */
 lr=syslrecl                                /*    record length */
 rf=insert(',',sysrecfm,1)                  /*    block size    */
 cc=BPXWDYN('Alloc rtddn($wrkdd) rtdsn($wrkds) da(&&LIB)',
            'lrecl('lr') recfm('rf') dir(4)' dsopt1)
 if cc<>0 then call close 8 "*alloc workfile failed" cc
 ddlist=$wrkdd ddlist
 cc=BPXWDYN('Alloc shr rtddn($sklfile) da('$wrkds'('$sklmbr')')
 if cc<>0 then call close 8 "*alloc wrkfile failed" cc
 ddlist=$sklfile ddlist
 address TSO "execio" line.0 "diskw" $sklfile "(stem line. finis)"
 if rc<>0 then call close 8 "*write member copy failed" rc
 Call Silent "free dd("$sklfile")"
 ddlist=subword(ddlist,2)

 /* run file tailoring services */
 cc=BPXWDYN('Alloc dd(ISPFILE) lrecl(200 recfm(v,b)' dsopt1)
 if cc<>0 then call close 8 "*alloc ISPFILE failed" cc
 ddlist='ISPFILE' ddlist
 address ispexec
 "Libdef ispslib library id("$wrkdd") stack"
 if rc<>0 then call close 8 '*libdef error' rc zerrlm
 "Ftopen"
 cc=''
 "Ftincl" $sklmbr
 if rc<>0 then cc='FTINCL' rc zerrlm
 "Ftclose"
 if cc='' & rc<>0 then cc='FTCLOSE' rc zerrlm
 "Libdef ispslib"
 if cc<>'' then call close 8 '*'cc

 /* copy result to temp dataset, then edit */
 cc=BPXWDYN('Alloc rtddn($editdd) lrecl(200 recfm(v,b)' dsopt1)
 if cc<>0 then call close 8 "*alloc EDIT ds failed" cc
 ddlist=$editdd ddlist
 cc=Silent("repro infile(ISPFILE) outfile("$editdd")")
 Call Silent "free dd(ISPFILE)"
 ddlist=Delword(ddlist,2,1)    /* drop ISPFILE */

 "lminit dataid($editdid) ddname("$editdd")"
 "edit dataid("$editdid") confirm(NO)"
 "lmfree dataid("$editdid")"
 Call Close 0

Close:
 parse arg clsrc clsmsg
 if clsmsg<>'' then say clsmsg
 if ddlist<>'' then Call Silent "free dd("ddlist")"
 Exit word(clsrc 0,1)
trace off

Silent:trace off;$=outtrap('$.');Address TSO arg(1);$=outtrap('off');return rc