/* REXX */ /*******************************************************************/ /* */ /* PROGRAMMNAME : DS */ /* call : TSO DS */ /* AUTHER : ULRICH BRAEUER */ /* FUNKTION : LIST DATASETS */ /* */ /* */ /*******************************************************************/ SIGNAL ON HALT SIGNAL OFF SYNTAX SIGNAL OFF FAILURE SIGNAL OFF ERROR LIBDEF = "N" LIBDEF = "Y" PARSE SOURCE SRC.1 , /* ENVIRONMENT (TSO) */ SRC.2 , /* Calld as (COMMAND) */ SRC.3 , /* PROGRAM NAME (FTPCOPY) */ SRC.4 , /* SYS00186 (TEMP FILE) */ SRC.5 , /* call from Library (x.X.CLIST) */ SRC.6 , /* ? */ SRC.7 , /* TSO */ SRC.8 , /* ISPF */ SRC.9 , /* ? */ . If src.3 = "?" Then Src.3 = "DS" ENV = "TSO" X = MSG('OFF') USER = USERID() TLIBDD = "'MGDB05.ISPF.ISPTLIB'" DSLIST = "DSLI0001" TLIBCHK = listdsi(TLIBDD) if TLIBCHK = 0 , ! TLIBCHK = 4 , ! TLIBCHK = 16 & ( SYSREASON = 8 , ! SYSREASON = 9 , ! SYSREASON = 19 , ! SYSREASON = 22 , ! SYSREASON = 25 , ! SYSREASON = 26 , ! SYSREASON = 27 , ! SYSREASON = 30 , ) Then DO Call copy_to_my_table DSLIST TLIBDD = "" End Else Do TLIBDD = "" End DATASET = "" IF Arg() > 0 Then Do DATASET = ARG(1) Call show_ds DATASET, '' Return End ADDRESS ISPEXEC 'TBOPEN 'DSLIST 'SHARE' if rc /= 0 then Do ADDRESS ISPEXEC "TBCREATE "DSLIST , " NAMES(SEL, DATASET, TEXT, AKTIVE, GRUPPE, ANZEIGE) ", " REPLACE" SEL = "" DATASET = "" TEXT = "" GRUPPE = "" AKTIVE = "9" Do i = 1 to 5 Call ADD_TABLE end End ADDRESS ISPEXEC "TBSTATS "DSLIST , " ROWCURR(ROWS) ", "" ADDRESS ISPEXEC 'TBCLOSE 'DSLIST ADDRESS ISPEXEC 'TBOPEN 'DSLIST 'SHARE' CURSOR = 'CURSOR(ZCMD)' CSRROW = 'CSRROW(1)' RETCODE = RC MESSAGE = 'MSG( )' ZTDSELS = 0 ZTDTOP = 0 LNR = 1 CRP = 1 address ISPEXEC 'TBCLOSE 'DSLIST ADDRESS ISPEXEC 'VGET (ZSCREEN) ' SCRNR = ZSCREEN If LIBDEF = "Y" then Do DSNAME = Space(USERID()"."MVSVAR("SYSNAME")"."SRC.3".TMPFIL",0) DSNAME = Space(USERID() "." , MVSVAR("SYSNAME") SCRNR "." , SRC.3 "." , TMPFIL,0) PLIBDS = "'" !! DSNAME !! "'" ADDRESS "TSO" ADDRESS "TSO" "FREE FI(PLIB)" ADDRESS TSO "DELETE " !! PLIBDS X = MSG('ON') resp = OUTTRAP(errycos.,"*","NOCONCAT") ADDRESS "TSO" "ALLOC F(PLIB) DA("PLIBDS") NEW CATALOG " , "SPACE(1,20) CYL DIR(100) " , "LRECL(80) UNIT(SYSDA) RECFM(F,B)" , "DSNTYPE(LIBRARY) " , "" IF rc <> 0 THEN DO ADDRESS "TSO" "FREE FI(PLIB)" ADDRESS TSO "DELETE " !! PLIBDS SAY "Error on ALLOC Input File" PLIBDS ", RC =" rc DO i=1 to errycos.0 SAY errycos.i END EXIT END DROP WLine. Call PAN_PDS MemName = 'PDS' Call Write_Mem DROP WLine. Call PAN_PDS1 MemName = 'PDS1' Call Write_Mem X = MSG('OFF') "FREE F(PLIB)" ADDRESS "TSO" "FREE FI(PLIB)" ADDRESS "TSO" "ALLOC F(PLIB) DA("PLIBDS") SHR" ADDRESS "TSO" "FREE FI(PLIB)" ADDRESS ISPEXEC ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID("PLIBDS") UNCOND STACK" If TLIBDD <> "" Then Do "LIBDEF ISPTLIB DATASET ID("TLIBDD") UNCOND STACK" "LIBDEF ISPTABL DATASET ID("TLIBDD") UNCOND STACK" End ADDRESS "TSO" End SDS = "*" STXT = "*" oSDS = "*" oSTXT = "*" LAUFNR = 1 SCAVAR = "ALL" DO FOREVER CURSOR = 'CURSOR(SEL)' address ISPEXEC 'TBOPEN 'DSLIST 'SHARE' address ISPEXEC 'TBTOP 'DSLIST Call Search_TABLE address ISPEXEC 'TBSKIP 'DSLIST' NUMBER('ZTDTOP')' address ispexec 'TBDISPL 'DSLIST' PANEL(PDS)', MESSAGE CURSOR 'CSRROW('LAUFNR')' , 'AUTOSEL(NO) POSITION(CRP)' If rc > 4 then do Say "*** Fehler beim Display Alter RC="rc Say " ZERRSM =" ZERRSM Say " ZERRLM =" ZERRLM exit End COMMAND = ZCMD /* check PF keys */ Select WHEN WORD(COMMAND,1) = "I" THEN DO SEL = "" DATASET = "" TEXT = "" AKTIVE = "9" GRUPPE = "" If Datatype(WORD(COMMAND,2))= "NUM" Then Do ANZ = WORD(COMMAND,2) End ELSE ANZ = 1 Do wi = 1 to anz Call ADD_TABLE End ZTDSELS = 0 end WHEN Substr(WORD(COMMAND,1),1, 1) = "I" THEN DO SEL = "" DATASET = "" TEXT = "" AKTIVE = "9" GRUPPE = "" IF DATATYPE(SUBSTR(WORD(COMMAND,1), 2)) = "NUM" THEN DO ANZ = SUBSTR(WORD(COMMAND,1), 2) End ELSE ANZ = 1 Do wi = 1 to anz Call ADD_TABLE End ZTDSELS = 0 end WHEN SUBSTR(COMMAND,1,3) = "CAN" THEN DO LEAVE end WHEN Word(COMMAND, 1) = "SORT" THEN DO address ISPEXEC 'TBSORT 'DSLIST' FIELDS(GRUPPE,C,A ' , ',AKTIVE,C,A ' , ',DATASET,C,A ' , ',TEXT,C,A) ' end When PF = 'PF03' THEN DO LEAVE end When PF = 'PF04' THEN DO LEAVE end When PANELRC = 8 THEN DO LEAVE end Otherwise NOP End if ZTDSELS > 0 Then LAUFNR = crp DO while ZTDSELS > 0 ANZ = 1 If Substr(DATASET, 1, 1) <> "/" Then Do DATASET = Translate(Dataset) TEXT = Translate(TEXT) End DATASET_NEW = DATASET TEXT_NEW = TEXT SEL_NEW = SEL ADDRESS ISPEXEC 'TBGET 'DSLIST If Substr(DATASET, 1, 1) <> "/" Then Do DATASET = Translate(Dataset) TEXT = Translate(TEXT) End SEL = SEL_NEW IF DATASET_NEW /= DATASET Then Do DATASET = DATASET_NEW SEL = "U" End IF TEXT_NEW /= TEXT Then Do TEXT = TEXT_NEW IF SEL = "" THEN SEL = "U" End If Substr(SEL, 1, 1) = "I" , ! Substr(SEL, 1, 1) = "D" THEN DO IF DATATYPE(SUBSTR(SEL, 2)) = "NUM" THEN DO ANZ = SUBSTR(Sel, 2) End ELSE Do ANZ = 1 End SEL = Substr(SEL, 1, 1) End Select When SEL = "S" Then Do Address ispexec 'TBCLOSE 'DSLIST CLOSE = "Y" CALL show_ds DATASET, '' Leave End When SEL = "D" Then Do SEL = "" DATASET = "" TEXT = "" GRUPPE = "" Do seli = 1 to ANZ ADDRESS ISPEXEC 'TBDELETE 'DSLIST End End When SEL = "U" Then Do SEL = "" AKTIVE = "1" IF DATASET = "" Then AKTIVE = "9" ADDRESS ISPEXEC 'TBPUT 'DSLIST End When SEL = "I" Then Do SEL = "" DATASET = "" TEXT = "" GRUPPE = "" AKTIVE = "9" Do SELI = 1 To ANZ Call ADD_TABLE end End When SEL = "E" Then Do ADDRESS ISPEXEC "DISPLAY PANEL(PDS1)" SEL = "" COMMAND = ZCMD ADDRESS ISPEXEC 'TBPUT 'DSLIST If RC <> 0 Then do SAY "TBMOD RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM End GRUPPE = "" DATASET = "" TEXT = "" AKTIVE = "" GRUPPE = "" LEAVE End When SEL = "C" Then Do COMMAND = ZCMD Call ADD_TABLE ADDRESS ISPEXEC "DISPLAY PANEL(PDS1)" SEL = "" COMMAND = ZCMD ADDRESS ISPEXEC 'TBPUT 'DSLIST If RC <> 0 Then do SAY "TBMOD RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM ="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM ="ZERRSM End LEAVE End Otherwise nop End ADDRESS ISPEXEC 'TBSKIP 'DSLIST if ZTDSELS = 1 then Leave address ispexec 'TBDISPL 'DSLIST end IF CLOSE <> "Y" Then Address ispexec 'TBCLOSE 'DSLIST CLOSE = "N" End exit_all: address ispexec 'TBCLOSE 'DSLIST If LIBDEF = "Y" then Do ADDRESS ISPEXEC "LIBDEF ISPPLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTLIB DATASET ID( )" ADDRESS ISPEXEC "LIBDEF ISPTABL DATASET ID( )" "FREE F(PLIB)" ADDRESS TSO "DELETE " !! PLIBDS End Return ADD_TABLE: ADDRESS ISPEXEC 'TBADD 'DSLIST If RC <> 0 Then do SAY "RC="RC ERRORTEXT(RC) say "ZEDSMSG="ZEDSMSG say "ZERRLM="ZERRLM say "ZERRMSG="ZERRMSG say "ZERRSM="ZERRSM End Return Search_TABLE: IF Substr(SDS, 1, 1) <> "/" Then SDS = TRANSLATE(SDS) IF Substr(STXT, 1, 1) <> "/" Then STXT = TRANSLATE(STXT) if ZTDSELS > 0 Then LAUFNR = crp if OSDS <> SDS & OSTXT <> STXT Then Do ZTDTOP = 1 End OSDS = SDS OSTXT = STXT if SDS = "" Then SDS = "*" if STXT = "" Then STXT = "*" If SGR = "*" & SCMD = "*" & SCMD = "*" & STXT = "*" Then do SCAVAR = "ALL" End Else Do Call Search_TABLE2 End Return Search_TABLE2: SCAVAR = "SCAN" ADDRESS ISPEXEC 'TBTOP 'DSLIST ADDRESS ISPEXEC 'TBSKIP 'DSLIST Do while rc = 0 ANZEIGE = "YES" ADDRESS ISPEXEC 'TBPUT 'DSLIST ADDRESS ISPEXEC 'TBSKIP 'DSLIST End ADDRESS ISPEXEC 'TBTOP 'DSLIST ADDRESS ISPEXEC 'TBSKIP 'DSLIST Do while rc = 0 If SDS <> "" & SDS <> "*" Then Do If Pos(SDS, DATASET) = 0 Then Do ANZEIGE = "NO" End End If STXT <> "" & STXT <> "*" Then Do If Pos(STXT, TEXT) = 0 Then Do ANZEIGE = "NO" End End If Anzeige = "NO" Then Do ADDRESS ISPEXEC 'TBPUT 'DSLIST End ADDRESS ISPEXEC 'TBSKIP 'DSLIST End SCAVAR = "SCAN" ADDRESS ISPEXEC 'TBTOP 'DSLIST ADDRESS ISPEXEC 'TBVCLEAR 'DSLIST ANZEIGE = "YES" ADDRESS ISPEXEC 'TBSARG 'DSLIST , ' NAMECOND(ANZEIGE,EQ)' ADDRESS ISPEXEC Return Search_TABLE_old: IF Substr(SDS, 1, 1) <> "/" Then SDS = TRANSLATE(SDS) IF Substr(STXT, 1, 1) <> "/" Then STXT = TRANSLATE(STXT) if ZTDSELS > 0 Then LAUFNR = crp if OSDS <> SDS & OSTXT <> STXT Then Do ZTDTOP = 1 End OSDS = SDS OSTXT = STXT if SDS = "" Then SDS = "*" if STXT = "" Then STXT = "*" If SDS = "*" & STXT = "*" Then do SCAVAR = "ALL" End Else Do IF POS("*", SDS) = 0 Then SDS = SDS !! "*" IF POS("*", STXT) = 0 Then STXT = STXT !! "*" SCAVAR = "SCAN" ADDRESS ISPEXEC 'TBVCLEAR 'DSLIST DATASET = SDS TEXT = STXT ADDRESS ISPEXEC 'TBSARG 'DSLIST , ' NAMECOND(DATASET,EQ,TEXT,EQ)' End ADDRESS ISPEXEC /* do while rc = 0;say dataset aktive ;'TBSKIP 'DSLIST; end; */ Return show_ds: Parse ARG DSNLEV VOL select When Substr(DSNLEV, 1, 1) = "/" Then Call show_ds_USS DSNLEV VOL When POS('(', DSNLEV ) > 0 Then Call show_ds_Memlist DSNLEV VOL Otherwise Call show_ds_ZOS DSNLEV VOL End Return Rc show_ds_Zos: Parse UPPER ARG DSNLEV VOL If DSNLEV= '' then do /* no DSNLEV specified */ UID = SYSVAR('SYSUID') DSNLEV = UID !! '.*' /* use USERID.* as default */ End Else DSNLEV = Strip(Translate(DSNLEV,"","'")) /* remove any quotes */ Address ISPEXEC "LMDINIT LISTID(XDSLIST) LEVEL("DSNLEV") VOLUME("VOL")" "LMDDISP LISTID("XDSLIST")" If RC <> 0 then "SETMSG MSG("ZERRMSG")" Return Rc show_ds_Memlist: Parse UPPER ARG DSNLEV VOL Parse value dsnlev with DSNLEV "(" MEM ")" . DSNLEV = Strip(Translate(DSNLEV,"","'")) /* remove any quotes */ Address ISPEXEC "LMINIT DATAID(DATAODV) DATASET('"DSNLEV"')" zedsmsg = "" zedlmsg = "Member List der Datei" DSNLEV "nur Members "MEM "SETMSG MSG(ISRZ001)" "MEMLIST DATAID("DATAODV") MEMBER("MEM")" "LMFREE DATAID("DATAODV")" "LMDINIT LISTID(XDSLIST) LEVEL("DSNLEV") VOLUME("VOL")" "LMDDISP LISTID("XDSLIST")" If RC <> 0 then "SETMSG MSG("ZERRMSG")" Return Rc show_ds_USS: Parse ARG DIR VOL ADDRESS ISPEXEC /* "DIRLIST PATH(dir) COLS(PE,10,TY,4,MO,10) LCMDS(LCPROC,LL,B,UPD)"*/ "DIRLIST PATH(dir) COLS(PE,10,TY,4,MO,10) " If RC <> 0 then "SETMSG MSG("ZERRMSG")" Return Rc PAN_PDS: Z=")ATTR" OK=WL(Z) Z=" ! type(input) intens(high) caps(OFF) pad(' ')" OK=WL(Z) Z=" ø type(input) intens(high) caps(On ) pad(' ')" OK=WL(Z) Z=" õ type(output) intens(low ) just(left) caps(off) padc('')" OK=WL(Z) Z=" ? type(output)intens(high) just(left) caps(off) padc('')" OK=WL(Z) Z=")BODY EXPAND(//)" OK=WL(Z) Z="%Dataset List -/-/- +" OK=WL(Z) Z="%Command ===>_zcmd / / %Scroll ===>" !!, "_AMT + " OK=WL(Z) Z="+ +" OK=WL(Z) Z=" S=SELECT E=EDIT C=COPY I=INSERT D=DELETE +" OK=WL(Z) Z="&SEL+Dataset +description " !!, " + " OK=WL(Z) Z="+--- ------------------------------------------- ---------------" !!, "-------+ " OK=WL(Z) Z="+ !SDS !STXT " !!, " + " OK=WL(Z) Z=")MODEL ROWS(&SCAVAR)" OK=WL(Z) Z="øSEL!DATASET !TEXT " !!, " + " OK=WL(Z) Z=")INIT" OK=WL(Z) Z=")PROC" OK=WL(Z) Z="&PF = .PFKEY" OK=WL(Z) Z="&PANELRC = 0" OK=WL(Z) Z="IF (.RESP = END,RETURN)" OK=WL(Z) Z=" .RESP = ENTER" OK=WL(Z) Z=" &PANELRC = 8" OK=WL(Z) Z="IF (&ZCMD = CAN,CANCEL)" OK=WL(Z) Z=" &PANELRC = 9" OK=WL(Z) Z=")End" OK=WL(Z) RETURN PAN_PDS1: Z=")ATTR" OK=WL(Z) Z=" + TYPE(TEXT) INTENS(LOW) SKIP(ON) color(WHITE)" OK=WL(Z) Z=" $ TYPE(TEXT) INTENS(HIGH) SKIP(ON) color(pink)" OK=WL(Z) Z=" * TYPE(OUTPUT) INTENS(LOW) SKIP(ON)" OK=WL(Z) Z=" ! TYPE(OUTPUT) INTENS(HIGH) SKIP(ON)" OK=WL(Z) Z=" ? type(INPUT ) intens(high) just(left) caps(off) padc('')" OK=WL(Z) Z=")BODY EXPAND(áá)" OK=WL(Z) Z="%á-á Edit Execute Statement á-á" OK=WL(Z) Z="%Command ===>_ZCMD " !!, " + " OK=WL(Z) Z="+ Grup : _Gruppe +" OK=WL(Z) Z="" OK=WL(Z) Z="+ DATASET :+?DATASET " !!, " + " OK=WL(Z) Z="" OK=WL(Z) Z="" OK=WL(Z) Z="+ description :+?TEXT " !!, " + " OK=WL(Z) Z="" OK=WL(Z) Z="+ ACtive :+_AKTIVE +" OK=WL(Z) Z="+" OK=WL(Z) Z="+!Z " !!, " + " OK=WL(Z) Z="%á-á E n d e á-á" OK=WL(Z) Z=")INIT" OK=WL(Z) Z=" .ZVARS = '(MSGLINE )'" OK=WL(Z) Z=" .HELP = PCMD1H" OK=WL(Z) Z=" &USER = &USER" OK=WL(Z) Z=" &MSGLINE = &MSGLINE" OK=WL(Z) Z=")PROC" OK=WL(Z) Z="&PF = .PFKEY" OK=WL(Z) Z=")END" OK=WL(Z) RETURN WL: if Datatype(WLine.0) <> "NUM" Then WLine.0 = 0 WLine.0 = WLine.0 + 1 WLineI = WLine.0 WLine.WLineI = Arg(1) Return 0 Write_Mem: ADDRESS ISPEXEC 'LMINIT DATAID(DID) DDNAME(PLIB) ENQ(EXCLU)' 'LMOPEN DATAID(&DID) OPTION(OUTPUT)' 'LMMDEL DATAID(&DID) MEMBER('MemName')' Do i = 1 to WLine.0 P1 = WLine.i "LMPUT DATAID(&DID) MODE(INVAR) DATALOC(P1) DATALEN(80)" End 'LMMADD DATAID(&DID) MEMBER('MemName')' 'LMFREE DATAID(&DID)' 'LMCLOSE DATAID(&DID)' 'LMFREE DATAID(&DID)' Return 0 copy_to_my_table: MEMNAME = Arg(1) DDNAME = 'ISPTABL' Ret = LISTDSI(DDNAME' FILE') fromds = tlibdd fromds = Strip(fromds, , "'") !! "(" !! MEMNAME !! ")" fromds = "'" !! fromds !! "'" tods = "'" !! SYSDSNAME !! "(" !! MEMNAME !! ")'" /* Wenn datei schon da ist, dann nicht kopieren */ IF SYSDSN(fromds) <> "OK" then Do Return End IF SYSDSN(tods) = "OK" then Do Return End /* not found then copy dataset */ ADDRESS ISPEXEC "LMINIT DATASET("TLIBDD") DATAID(inpSID) ENQ(SHR)" "LMINIT DATASET('"SYSDSNAME"') DATAID(OUTSID) ENQ(SHRw)" "LMCOPY FROMID("inpSID") TODATAID("OUTSID") " , "FROMMEM("MEMNAME") TOMEM("MEMNAME")" IF RC = 0 THEN Do "LMFREE DATAID("INPSID")" "LMFREE DATAID("OUTSID")" End ADDRESS "TSO" return error: failure: syntax: novalue: halt: Address ISPEXEC "TBCLOSE "DSLIST rexx = sysvar(sysicmd) say SRC.3":" cstr = CONDITION('Condition') /* Name of trapped condition*/ istr = CONDITION('Instruction') /* CALL or SIGNAL */ dstr = CONDITION('Description') /* Description or null */ sstr = CONDITION('Status') /* ON, OFF, or DELAY */ Say 'Condition :'cstr say 'Instruction:'istr say 'Description:'dstr say 'Status :'sstr If condition = 'HALT' Then do Say SRC.3 "manually abort " condition condition('C') End Else Do Say SRC.3 condition condition = condition('C') source = strip(sourceline(sigl),"B") say copies('*',79) say left('* 'condition' CONDITION ON LINE 'sigl' OF REXX 'rexx,78)'*' say left('* 'source,78)'*' say left('* RETURN CODE 'rc,78)'*' say left('* 'errortext(rc),78)'*' say copies('*',79) End exit 100 return