/* Rexx */ ibmlib ="'PDFTDEV.SVT.PANELGEN'" /* IBM's shipped libraries */ userlib ="'PDFTDEV.DGN.PANELGEN'" /* An empty fixed 80 pds for output */ /* ----------------------------------------------------------------- */ /* Last update : August 10, 2000 */ /* */ /* Instructions: */ /* */ /* 1) Change the data set names above: */ /* userlib is the data set to put new panels in. */ /* IBMlib is the data set containing IBM's shipped panels */ /* 2) Move this EXEC to your SYSPROC or SYSEXEC concatenation. */ /* 3) Run this exec as a command (eg TSO %AUTOINST) */ /* It will not work with just the EXEC command. */ /* EXEC CLIST(AUTOINST) will NOT work. */ /* */ /* 4) if you haven't already done so, install the AUTOTYPE */ /* load module into an accessible load lib (steplib, etc) */ /* and set a PFKEY to AUTOTYPE. It works best if you also */ /* have a command table entry of AUTOTYPE 0 SETVERB */ /* but that is not required. */ /* */ /* Changes: 06.26.2000 - shift all existing logic lines left until */ /* one is in col 1. This fixes some problems */ /* where existing panel logic becomes part of */ /* autotypes 'if' clause. */ /* */ /* Added REFRESH(*) at the end of the REINIT */ /* section instead of the beginning. */ /* */ /* Changes: 08.10.2000 - swapped comments on 1st two lines */ /* */ /* ----------------------------------------------------------------- */ Address ispexec 'CONTROL ERRORS RETURN' Address isredit 'MACRO' If rc=0 Then /* This is the macro call */ Call change_panel 'ALLOC F(ASETUP) DA(' userlib ibmlib') SHR REUSE' Address ispexec Parse Source . . me . 'CONTROL ERRORS RETURN' 'LMINIT DATAID(DID) DDNAME(ASETUP) ENQ(SHRW)' Call perform_change('ISREDM01') /* OPTION 2 */ Call perform_change('ISRBRO01') /* OPTION 1 */ Call perform_change('ISRUDA1 ') /* OPTION 3.1 */ Call perform_change('ISRUDA2S') /* OPTION 3.2 */ Call perform_change('ISRUMC1 ') /* OPTION 3.3 */ Call perform_change('ISRUMC2A') /* OPTION 3.3 */ Call perform_change('ISRUMC2B') /* OPTION 3.3 */ Call perform_change('ISRUDLP ') /* OPTION 3.4 */ Call perform_change('ISRSFPRI') /* OPTION 3.12 */ Call perform_change('ISRSSNEW') /* OPTION 3.12 */ Call perform_change('ISRSFSPR') /* OPTION 3.14 */ Call perform_change('ISRSSOLD') /* OPTION 3.15 */ Call perform_change('FLMEB#P ') /* OPTION 10.1 */ 'LMFREE DATAID(&DID)' Address tso 'FREE F(ASETUP)' Exit /* ------ */ perform_change: Parse Upper Arg mem 'EDIT DATAID('did') MEMBER('mem') MACRO('me')' Return /* ------ */ change_panel: Address isredit '(MEMBER) = member' 'F AUTOTYPE' If rc=0 Then Do Say 'Panel 'left(member,8)' appears to be modified already' 'CANCEL' Exit End Else Say 'Processing panel 'member'...' 'F .ZVARS LAST' If rc>0 Then Do Say 'zvars not found' Exit End '(line) = line .ZCSR' Call getnames If names ='' Then /* Not a known panel */ Do Say 'This is not a known panel. Check changes carefully.' Parse Var line . '(' zcmd proj g1 g2 g3 g4 t m odsn . names=proj g1 g2 g3 g4 t m odsn zcmd End "FIND ')REINIT' FIRST 1" If rc>0 Then Do "FIND ')PROC' 1 FIRST" 'LINE_BEFORE .ZCSR = ")REINIT"' "FIND ')REINIT' FIRST 1" End Call addline ' .CURSOR = &CSRV' Call addline 'IF (&ZNXTMSG=NEXT) .CSRPOS = &CSRP' Call shifter ')PROC' "FIND ')PROC' 1 FIRST" Call addline "IF (&ZNXTMSG='NEXT') EXIT" Call addline "PANEXIT((NAMES),LOAD,AUTOTYPE)" If names2<> '' Then Do Call addline "&NAMES='&NAMES. "names2"'" End Call addline "&NAMES='"names"'" Call addline "&CSRP = .CSRPOS" Call addline "&CSRV = .CURSOR" "FIND 'REFRESH' word first" If rc>0 Then Do "FIND ')REINIT' FIRST 1" 'line_after .ZCSR = "REFRESH (*)"' End "FIND ')REINIT' FIRST 1" "COMP *" "F .ZVARS LAST" Address isredit 'END' Exit /* ----------------------------------------------------------------- */ addline: Parse Upper Arg line If length(line)<55 Then line=substr(line,1,55) If length(line)<63 Then line=line' /* AUTOTYPE */' 'LINE_AFTER .ZCSR = (LINE)' Return /* ----------------------------------------------------------------- */ shifter: Procedure 'F "'Arg(1)'" 1 first' If rc=0 Then Do '(f) = linenum .zcsr' f=f+1 /* get line num of 1st logic line */ 'LABEL 'f' = .F 0' 'F ")" 1 NEXT' '(la) = linenum .zcsr' If la = f Then Return la=la-1 /* get line num of last logic line */ 'LABEL 'la' = .LA 1' Do 80 Until findrc=0 "F P'¬' 1 .f .la first" findrc=rc If findrc>0 Then Do 'C " " "00"x all .LA .F' 'C "00"X "" all 1 .la .f' 'C "00"x " " all .LA .F' End End End Return /* ----------------------------------------------------------------- */ getnames: Parse Value '' With names names2 If member='FLMEB#P ' Then names='SPRJ1 SLIB1 SLIB2 SLIB3 SLIB4 STYP1 MEM ZODSN ZCMD' If member='ISREDM01' Then names='PRJ1 LIB1 LIB2 LIB3 LIB4 TYP1 MEM DSN ZCMD' If member='ISRBRO01' Then names='PRJ1 LIB1 LIB2 LIB3 LIB4 TYP1 ZMEM ZODSN ZCMD' If member='ISRUDA1 ' Then names='PRJ1 LIB1 LIB2 LIB3 LIB4 TYP1 MEMB DSN ZCMD' If member='ISRUDA2S' Then names='PRJ0 LIB0 * * * TYP0 * DSN ZCMD' If member='ISRUMC1 ' Then names='PRJ1 LIB1 LIB2 LIB3 LIB4 TYP1 MEMB DSN1 ZCMD' If member='ISRUMC2A' Then names='PROJ2 LIBR2 * * * TYPE2 MEMB2 DSN2 ZCMD' If member='ISRUMC2B' Then names='PROJ2 LIBR2 * * * TYPE2 * DSN2 ZCMD' If member='ISRUDLP ' Then names='* * * * * * * ZDLDSNLV ZCMD' If member='ISRSFPRI' Then names='* * * * * * * SF4FILE ZCMD' If member='ISRUDLP ' Then names='* * * * * * * ZDLDSNLV ZCMD' If member='ISRSSNEW' Then Do names='ZSSCNPRJ ZSSCNGR1 ZSSCNGR2 ZSSCNGR3 ZSSCNGR4' names2='ZSSCNTYP ZSSCNIMB ZSSCNDSN ZCMD' End If member='ISRSSOLD' Then Do names='ZSSCOPRJ ZSSCOGR1 ZSSCOGR2 ZSSCOGR3 ZSSCOGR4' names2='ZSSCOTYP ZSSCOIMB ZSSCODSN ZCMD' End If member='ISRSFSPR' Then Do names='ZSSFNPRJ ZSSFNGR1 ZSSFNGR2 ZSSFNGR3 ZSSFNGR4' names2='ZSSFNTYP ZSSFNIMB ZSSFNDSN ZCMD' End names='CSRV CSRP 'names Return