./ ADD NAME=$INDEX ASMAGALC - Assembler program with wrapper JCL to Assemble and Link CLCPCOMH - Panel that displays when COMMAND command issued CLCPDSNI - Panel for Dataset Info ("S" line command) CLCPTIOT - Primary display panel SHOWDSNS - Primary REXX EXEC To install: 1) Assemble and link the program named CLCAGALC. Ensure that the load library can be either LIBDEF'd or added to your TSO session search path via ISPLLIB or TSOLIB inclusion. 2) Add the three panels to an 80-byte PDS that can be either LIBDEF'd or one that is already allocated to the ISPPLIB DD NAME of your TSO session. 3) Add the SHOWDSNS REXX EXEC to an 80-byte PDS that can be ALTLIB'd or one that is already allocated to the SYSPROC (or SYSEXEC) DD NAME of your TSO session. If you elect to LIBDEF the panel and load library, please read the comments near the begining of the SHOWDSNS REXX EXEC. When everything is in place, invoke the dialog by typing: Command ===> TSO SHOWDSNS from any Command line in ISPF. ./ ADD NAME=ASMAGALC //jobname JOB (1111,2222),ASSEM.CLCAGALC, 00010000 // CLASS=A,MSGCLASS=A,NOTIFY=&SYSUID, 00020000 // MSGLEVEL=(1,1),REGION=0M 00030000 //* 00040000 //* ----------------- ASSEMBLE CLCAGALC ------------------------- 00060000 //ASM EXEC PGM=ASMA90,PARM=(NOADATA,ALIGN,NOASA,RENT,NODECK) 00070000 //* 00080000 //SYSTERM DD SYSOUT=* 00090000 //SYSPRINT DD SYSOUT=* 00100000 //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(5,1)) 00110000 //SYSUT2 DD UNIT=SYSDA,SPACE=(CYL,(5,1)) 00120000 //SYSUT3 DD UNIT=SYSDA,SPACE=(CYL,(5,1)) 00130000 //SYSLIN DD DSN=&CLCAGALC,DISP=(NEW,PASS,DELETE), 00140000 // UNIT=SYSDA,SPACE=(CYL,(1,1)), 00150000 // LRECL=80,RECFM=FB,DSORG=PS 00160000 //* 00170000 //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR TSO/ISPF TIOT Translater Object ' 03550000 DC CL50'Copyright - Concentrated Logic Corporation 1994 ' 03560000 DC CL16'Author: JB Moore' 03570000 DC C' &SYSASM ' 03580000 DC C' &SYSDATC ' 03590000 DC C' &SYSTIME ' 03600000 DS 0F . Alignment 03610000 DINRELNO DS 0CL8 . Fixed parts of Text Units 03620000 DC H'15',H'1',H'2' 03630000 REQNO DC H'1' 03640000 DINRTDDN DS 0CL14 03650000 DC H'4',H'1',H'8' 03660000 RETDDN DC CL8' ' 03670000 DINRTLST DS 0CL7 03680000 DC H'13',H'1',H'1' 03690000 LASTONE DC XL1'00' 03700000 DS 0F 03710000 DINRTDSN DS 0CL50 03720000 DC H'5',H'1',H'44' 03730000 RETDSN DC CL44' ' 03740000 DINRTSTA DS 0CL7 03750000 DC H'07',H'1',H'1' 03760000 RETSTA DC CL1' ' 03770000 DS 0F 03780000 DINRTNDP DS 0CL7 03790000 DC H'08',H'1',H'1' 03800000 RETDP DC CL1' ' 03810000 *--------------------------------------.------------------------------ 03820000 BLANKS DC CL44' ' . Other Constants 03830000 VDEFINE DC CL08'VDEFINE' 03840000 VPUT DC CL08'VPUT' 03850000 TBCREATE DC CL08'TBCREATE' 03860000 TBADD DC CL08'TBADD' 03870000 TBTOP DC CL08'TBTOP' 03880000 CHAR DC CL04'CHAR' 03890000 NOWRITE DC CL08'NOWRITE' 03900000 REPL DC CL08'REPLACE' 03910000 LEN44 DC F'44' 03920000 LEN8 DC F'8' 03930000 LEN6 DC F'6' 03940000 LEN7 DC F'7' 03950000 LEN3 DC F'3' 03960000 LEN1 DC F'1' 03970000 LEN4 DC F'4' 03980000 NAME1 DC C'(CLCXDSNM)' 03990000 NAME2 DC C'(CLCXDDNM)' 04000000 NAME3 DC C'(CLCXDISP)' 04010000 NAME4 DC C'(CLCXLCMD)' 04020000 NAME5 DC C'(CLCXSTAT)' 04030000 NAME6 DC C'(CLCXMSG)' 04040000 NAMETABL DS 0CL54 04050000 DC C'(CLCXLCMD,CLCXDDNM,CLCXDSNM,CLCXDISP,CLCXSTAT,' 04060000 DC C'CLCXMSG)' 04070000 ERRS DC C'(INFCHR,ERRCHR)' 04080000 NULLPARM DC C' ' 04090000 HEXTOCHR EQU *-C'0' 04100000 DC C'0123456789ABCDEF' 04110000 YREGS , 04120000 LTORG , 04130000 *-------------------------------------------------------------------- 04140000 *---------- "PARM=" Value (Name of table to TBCREATE)---------------- 04150000 *-------------------------------------------------------------------- 04160000 * 04170000 LINKAGE DSECT , 04180000 PASSNAME DS CL08 04190000 *-------------------------------------------------------------------- 04200000 *---------- "GETMAINed" Working Storage Area ------------------------ 04210000 *-------------------------------------------------------------------- 04220000 * 04230000 WORKSTOR DSECT , 04240000 SAVEAREA DS 18F . My own little save area... 04250000 ISPPARMS DS 0CL24 . ISPLINK parm list built here 04260000 ISPFSERV DS A . " " 04270000 PARMADR1 DS A . " " 04280000 PARMADR2 DS A . " " 04290000 PARMADR3 DS A . " " 04300000 PARMADR4 DS A . " " 04310000 PARMADR5 DS A . " " 04320000 DS 0F . SVC99 R15 Convert work flds 04330000 CHRRC DS CL4 . Character return code 04340000 CHRRCPAD DS CL1 . Pad by one for UNPK 04350000 DS 0F . Alignment 04360000 HOLDHALF DS H . Save R15 halfword here 04370000 RETCDE DS CL2 . Really a halfword 04380000 INFRS DS CL2 . Ditto 04390000 ERRRSN DS CL2 . Ditto 04400000 DS 0F . ----------------------------- 04410000 SAVECNT DS 0CL4 . DINRELNO Working Count 04420000 DS CL2 . 04430000 SAVECNT4 DS CL2 . (Using only last halfword) 04440000 TABLNAME DS CL8 . Passed on parm or defaulted 04450000 DS 0D . Alignment 04460000 REQBPNTR DS F . SVC99 Parm List 04470000 REQBLOCK DS 5F . Request Block 04480000 TEXTPNTR DS 50F . Text Unit Pointers 04490000 TEXTUNTS DS 50F . Text Units 04500000 *-------------------------------->>>>>>. Funtion pool variables 04510000 CLCXMSG DS CL6 . Message (Created blank) 04520000 CLCXDISP DS CL3 . Disposition 04530000 CLCX1BYT DS 0CL1 . 04540000 CLCXLCMD DS CL1 . Line Command (Created blank) 04550000 CLCXSTAT DS CL7 . Status 04560000 CLCXDSNM DS CL44 . Dataset Name 04570000 CLCXDDNM DS CL8 . DD Name 04580000 CHARERR DS 0CL8 . 04590000 INFCHR DS CL4 . Hex-to-Char SVC99 Info 04600000 ERRCHR DS CL4 . Hex-to-Char SVC99 Error 04610000 END CLCAGALC 04620000 //* 04630000 // IF RC LE 4 THEN 04640000 //LINK EXEC PGM=IEWL, 04650000 // PARM=(LET,LIST,MAP,XREF,RENT) 04660000 //syslib DD DSN=SYS1.LINKLIB,DISP=SHR _ZCMD + % Line Commands:-----------------------------+ + E (Edit) + + B (Browse) + + F (Free) - Must be in row w/DD Name + + S (Show) + + M (Mem List) - If installed + % Primary Commands:------------------------ + + CANCEL (CAN) Ends the dialog + + REFRESH (REF) Rebuilds TIOT display + + LOCATE (LOC, L) Locate a DD name + + FIND (F) Find text in DSNAME + + SEEK Locate members + + SWITCH mlq Switch to TIOT File + + ----------------------------------------- + + LOCATE:%LOCATE ddname + + FIND: %FIND text + + SEEK: %SEEK ddname member/pattern B + + + + Seek requires the ddname and member or + + pattern parameters. The "B" is optional. + + It will Browse member(s) on a match. + )INIT &ZWINTTL = 'SHOWDSNS Commands' &ZCMD = &Z )PROC )END ./ ADD NAME=CLCPDSNI )ATTR # TYPE(OUTPUT) INTENS(LOW) JUST(LEFT) CAPS(OFF) @ TYPE(OUTPUT) INTENS(LOW) JUST(RIGHT) CAPS(OFF) )BODY WINDOW(46,18) %Command ===>_ZCMD + + + + Allocated#SPCUC0 #ALLC01 + + Used#SPCUC1 + #USED01 + + Maximum dir blocks: #ALLC03 + + Used dir. blocks: #DIRB01 + + Number of members: #NUMM01 + + Volume: #VOLNO01 + + Unit: #SYSUNIT + + Organization: #SYSDSORG + + Record format: #SYSRECFM + + Record length: #SYSLRECL + + Block size: #BLKSZ01 + + 1st extent#SPCUC2 +#PRIMA01 + + Secondary#SPCUC3 + #SECND01 + + Created: #CREAT01 + + Last Referenced: #REFDT01 + + Expires: #EXPDT01 + )INIT &ZWINTTL = '&DSNAME' &ZCMD = &Z &SPCUC0 = TRANS (&SYSUNITS CYLINDER,cylinders: TRACK,tracks: BLOCK,blocks: MEGABYTE,megabytes: KILOBYTE,kilobytes: BYTE,bytes:) &SPCUC1 = &SPCUC0 &SPCUC2 = &SPCUC0 &SPCUC3 = &SPCUC0 )PROC )END ./ ADD NAME=CLCPTIOT )ATTR @ TYPE(OUTPUT) CAPS(OFF) INTENS(HIGH) } TYPE(INPUT) CAPS(ON) INTENS(HIGH) PAD('_') ? TYPE(OUTPUT) CAPS(ON) INTENS(LOW) _ TYPE(INPUT) CAPS(ON) INTENS(HIGH) % TYPE(TEXT) INTENS(HIGH) SKIP(ON) + TYPE(TEXT) INTENS(LOW) SKIP(ON) )BODY %.-------------------------&TITL %--------------------------.% ¦%Command ===>_ZCMD %Scroll ===>_Z % ¦% ¦%&LONGERR %¦% ¦+-%DDNAME+---%DSNAME+-----------------------------------%MSG+----%DISP+----%¦% )MODEL ¦}Z?Z ?Z +@Z ?Z ?Z %¦ )INIT .ZVARS = '(ZSCED,CLCXLCMD,CLCXDDNM,CLCXDSNM,CLCXMSG,CLCXDISP,CLCXSTAT)' &ZCMD = '' IF (&KEEPCMD = 1) &ZCMD = &HZCMD )PROC &HZCMD = &ZCMD &LONGERR = '' )END ./ ADD NAME=SHOWDSNS /* REXX ------------------------------------------ */ 00010000 /* Copyright 1994 - 2004 */ 00020000 /* Concentrated Logic Corporation */ 00030000 /* Not for Commercial Resale */ 00040000 /* Author: Jim Moore */ 00050000 /* ----------------------------------------------- */ 00060000 /* This REXX EXEC handles all terminal input via */ 00070000 /* Dialog Manager API calls to a table created by */ 00080000 /* the program "CLCAGALC". The CLCAGALC function */ 00090000 /* is a BAL object that uses SVC 99, Verb Code 7, */ 00100000 /* DINRELNO Text Unit to transfer a TSO session's */ 00110000 /* TIOT into an ISPF table. */ 00120000 /* ----------------------------------------------- */ 00130000 /* The following Primary Commands are supported: */ 00140000 /* ----------------------------------------------- */ 00150000 /* CANCEL - End the dialog. Same as END (PF3) */ 00160000 /* REFRESH - Rebuild and redisplay the TIOT table */ 00170000 /* LOCATE - Position table to a DD Name */ 00180000 /* COMMAND - Shows commands in pop-up */ 00190000 /* FIND - text in DSNAME (No RFIND) */ 00200000 /* SEEK - Seek thru a concatenation */ 00210000 /* Requires at least 2 trailing parms: */ 00220000 /* - SEEK ddname member/pattern */ 00230000 /* Optional 3rd parm: */ 00240000 /* - B (browse) */ 00250000 /* ----------------------------------------------- */ 00260000 /* All primary commands are handled via default */ 00270000 /* ZCMD passthru. That is, logic is coded within */ 00280000 /* this EXEC to handle all primary commands. There */ 00290000 /* are no command table entries. */ 00300000 /* ----------------------------------------------- */ 00310000 /* The following Line Commands are supported: */ 00320000 /* ----------------------------------------------- */ 00330000 /* E - Edit dataset in row */ 00340000 /* B - Browse dataset in row */ 00350000 /* S - LISTDSI in pop-up ("3.2 style Info") */ 00360000 /* F - Free dataset (or concat) in row */ 00370000 /* Requires a non-blank DD Name */ 00380000 /* Follows all MVS rules of dealloc */ 00390000 /* M - Member List in row */ 00400000 /* Requires installation of CLCTMLST function */ 00410000 /* */ 00420000 /* ---------------LOGIC FLOW---------------------- */ 00430000 /* Initialize: */ 00440000 /* Set CONTROL ERRORS RETURN to disable DM errors. */ 00450000 /* Create a randomly generated table name. This is */ 00460000 /* done so that the dialog can be used in more */ 00470000 /* than one sub-task or in a recursive "stacked" */ 00480000 /* environment. */ 00490000 /* Issue SELECT of BAL program to create TIOTTABL */ 00500000 /* Mainline: */ 00510000 /* TBDISPL and process commands */ 00520000 /* Note the following: */ 00530000 /* o Multiple line commands are processed with */ 00540000 /* the ZTDSELS/TBDISPL "DO WHILE" loop. */ 00550000 /* o ALWAYS save the active TBDISPL environment */ 00560000 /* with CONTROL DISPLAY SAVE/RESTORE in this */ 00570000 /* mode. */ 00580000 /* o Except for CANCEL, line commands are */ 00590000 /* processed before primary commands */ 00600000 /* o Most errors are trapped with OUTTRAP */ 00610000 /* and displayed on the primary panel */ 00620000 /* called CLCPTIOT. Otherwise, the default */ 00630000 /* IBM message called ISPZ000 is used. */ 00640000 /* Finalize: */ 00650000 /* TBEND the temporary table and exit */ 00660000 /* ----------------------------------------------- */ 00670000 /* A NOTE ON LIBDEF: I do not recommend using */ 00680000 /* LIBDEF for heavily used ISPF software. The */ 00690000 /* constant alloc/dealloc/BLDL work really adds */ 00700000 /* overhead. Also, all LIBDEF's should specify */ 00710000 /* the STACK parm upon entry. Upon exit, the null */ 00720000 /* LIBDEF will deactivate the existing LIBDEF. */ 00730000 /* ----------------------------------------------- */ 00740000 /* This version has LIBDEFs commented out. If you */ 00750000 /* use LIBDEF, replace lowercase DSNS with your */ 00760000 /* own - one Panel and one Load Library. */ 00761000 /* ----------------------------------------------- */ 00762000 /* DON'T FORGET TO UNCOMMENT NULL LIBDEFS IF YOU */ 00763000 /* CHOOSE TO USE LIBDEF. NEAR THE END OF THIS EXEC */ 00764000 /* ----------------------------------------------- */ 00765000 /* ADDRESS ISPEXEC 'LIBDEF ISPPLIB DATASET, 00766000 ID(''80-byte.panel.pds'') STACK' 00767000 IF RC /= 0 THEN 00768000 DO 00769000 ZMSG000S = 'Panel LIBDEF Error' 00770000 ZMSG000L = 'An active LIBDEF already in place for ISPPLIB' 00780000 ADDRESS ISPEXEC 'SETMSG MSG(ISPZ000)' 00790000 EXIT 8 00800000 END 00810000 ADDRESS ISPEXEC 'LIBDEF ISPLLIB DATASET ID(''recfm-u.loadlib''), 00820000 STACK' 00830000 IF RC /= 0 THEN 00840000 DO 00850000 ZMSG000S = 'Loadlib LIBDEF Error' 00860000 ZMSG000L = 'An active LIBDEF already in place for ISPLLIB' 00870000 ADDRESS ISPEXEC 'SETMSG MSG(ISPZ000)' 00880000 EXIT 8 00890000 END */ 00900000 /* ----------------------------------------------- */ 00910000 ADDRESS ISPEXEC 'CONTROL ERRORS RETURN'; 00920000 ADDRESS ISPEXEC 'VGET (ZUSER ZAPPLID ZREFMDE)'; 00930000 HOLDMODE = ZREFMDE 00940000 ZREFMDE = 'OFF' 00950000 /* ------------------------------------------------------------ */ 00960000 /* ZREFMDE is the IBM variable that deterimines if a referenced */ 00970000 /* dataset is placed into your active RefList. Because the SEEK */ 00980000 /* command can operate on a large number of datasets, I turn it */ 00990000 /* off in this EXEC and then re-establish it's saved value at */ 01000000 /* exit. */ 01010000 /* ------------------------------------------------------------ */ 01020000 ADDRESS ISPEXEC 'VPUT (ZREFMDE) PROFILE'; 01030000 TIOTRND = RANDOM(1,100000); 01040000 TIOTTABL = SUBSTR('T'TIOTRND'00000000',1,8); 01050000 W = SUBSTR('...........................',1,27) 01060000 ZTDMARK = SUBSTR('+'W 'End of Allocations' W'..+',1,80) 01070000 ADDRESS ISPEXEC 'SELECT PGM(CLCAGALC) PARM('TIOTTABL')' 01080000 R15 = RC 01090000 IF R15 = 1 THEN 01100000 DO 01110000 ZMSG000S = 'GETMAIN Error' 01120000 ZMSG000L = 'Failure to aquire storage for processing the TIOT' 01130000 ADDRESS ISPEXEC 'SETMSG MSG(ISPZ000)' 01140000 EXIT 8 01150000 END 01160000 IF R15 = 2 THEN 01170000 DO 01180000 ZMSG000S = 'ISPLINK Error' 01190000 ZMSG000L = 'ISPLINK module not on Operating System Search Path' 01200000 ADDRESS ISPEXEC 'SETMSG MSG(ISPZ000)' 01210000 EXIT 8 01220000 END 01230000 ADDRESS ISPEXEC 'VGET (INFCHR,ERRCHR)' 01240000 IF (INFCHR /= '0000') | (ERRCHR /= '0000') THEN 01250000 DO 01260000 ZMSG000S = 'SVC 99 Error' 01270000 ZMSG000L = 'Info Reason: 'INFCHR' Error Reason: 'ERRCHR 01280000 ADDRESS ISPEXEC 'SETMSG MSG(ISPZ000)' 01290000 EXIT 8 01300000 END 01310000 TITL = CENTER('TSO Session Allocations',25) 01320000 ZMSG000S = ' ' 01330000 DO FOREVER; 01340000 IF ZMSG000S /= ' ' THEN 01350000 ADDRESS ISPEXEC 'SETMSG MSG(ISPZ000)' 01360000 ADDRESS ISPEXEC 'TBDISPL 'TIOTTABL' PANEL(CLCPTIOT)'; 01370000 IF RC > 4 THEN LEAVE; 01380000 PARSE UPPER VAR ZCMD ZC01 ZC02 ZC03 ZC04 01390000 IF (ZC01 = 'CANCEL') | (ZC01 = 'CAN') THEN LEAVE; 01400000 KEEPCMD = 0 01410000 ZMSG000S = ' ' 01420000 IF ZTDSELS > 0 THEN 01430000 DO 01440000 ROWSELS = ZTDSELS 01450000 DO WHILE ROWSELS > 0 01460000 ROWSELS = ROWSELS -1 01470000 CLCXMSG = ' ' 01480000 IF CLCXLCMD = 'B' THEN 01490000 DO; 01500000 CLCXLCMD = ' ' 01510000 ADDRESS ISPEXEC 'CONTROL DISPLAY SAVE' 01520000 ADDRESS ISPEXEC 'BROWSE DATASET('''CLCXDSNM''')' 01530000 IF RC = 0 THEN CLCXMSG = 'Browse' 01540000 ELSE 01550000 IF RC = 12 THEN CLCXMSG = 'Len=0' 01560000 ELSE 01570000 IF RC = 14 THEN CLCXMSG = 'Nomem' 01580000 ELSE 01590000 IF RC = 16 THEN CLCXMSG = 'Nomems' 01600000 ELSE 01610000 DO 01620000 CLCXMSG = 'Error' 01630000 LONGERR = SUBSTR(ZERRLM,1,74) 01640000 ZMSG000L = LONGERR 01650000 ZMSG000S = 'Severe Browse Error' 01660000 END; 01670000 ADDRESS ISPEXEC 'CONTROL DISPLAY RESTORE' 01680000 END; 01690000 IF CLCXLCMD = 'E' THEN 01700000 DO; 01710000 CLCXLCMD = ' ' 01720000 ADDRESS ISPEXEC 'CONTROL DISPLAY SAVE' 01730000 ADDRESS ISPEXEC 'EDIT DATASET('''CLCXDSNM''')' 01740000 IF RC = 4 THEN CLCXMSG = 'Nosave' 01750000 ELSE 01760000 IF RC = 0 THEN CLCXMSG = 'Edit' 01770000 ELSE 01780000 IF RC = 14 THEN CLCXMSG = 'Inuse' 01790000 ELSE 01800000 IF RC = 16 THEN CLCXMSG = 'Nomems' 01810000 ELSE 01820000 DO 01830000 CLCXMSG = 'Error' 01840000 LONGERR = SUBSTR(ZERRLM,1,74) 01850000 ZMSG000L = LONGERR 01860000 ZMSG000S = 'Severe Edit Error' 01870000 END; 01880000 ADDRESS ISPEXEC 'CONTROL DISPLAY RESTORE' 01890000 END; 01900000 IF CLCXLCMD = 'F' THEN 01910000 DO; 01920000 CLCXLCMD = ' ' 01930000 IF CLCXDDNM = ' ' THEN CLCXMSG = 'No DD' 01940000 ELSE 01950000 DO; 01960000 X = OUTTRAP('SAVE.','*','NOCONCAT') 01970000 ADDRESS TSO 'FREE DD('CLCXDDNM')' 01980000 IF RC = 0 THEN CLCXMSG = 'Freed' 01990000 ELSE 02000000 DO 02010000 LONGERR = SAVE.1 02020000 CLCXMSG = 'Error' 02030000 ZMSG000L = LONGERR 02040000 ZMSG000S = 'Free Error' 02050000 END 02060000 END; 02070000 END; 02080000 IF CLCXLCMD = 'S' THEN 02090000 DO; 02100000 CLCXLCMD = ' ' 02110000 X = LISTDSI(''''CLCXDSNM'''' DIRECTORY NORECALL) 02120000 IF SYSREASON = 0 THEN 02130000 DO; 02140000 ADDRESS ISPEXEC 'CONTROL DISPLAY SAVE' 02150000 DSNAME = SYSDSNAME 02160000 VOLNO01 = SYSVOLUME 02170000 BLKSZ01 = SYSBLKSIZE 02180000 PRIMA01 = SYSPRIMARY 02190000 SECND01 = SYSSECONDS 02200000 CREAT01 = SYSCREATE 02210000 EXPDT01 = SYSEXDATE 02220000 REFDT01 = SYSREFDATE 02230000 ALLC01 = SYSALLOC 02240000 ALLC02 = SYSEXTENTS 02250000 USED01 = SYSUSED 02260000 DIRB01 = 'Not a PDS' 02270000 NUMM01 = DIRB01 02280000 ALLC03 = DIRB01 02290000 IF SYSUDIRBLK > 0 THEN 02300000 DO 02310000 DIRB01 = SYSUDIRBLK 02320000 ALLC03 = SYSADIRBLK 02330000 NUMM01 = SYSMEMBERS 02340000 END; 02350000 IF EXPDT01 = 0 THEN EXPDT01 = '***Perm***' 02360000 ADDRESS ISPEXEC 'ADDPOP ROW(2) COLUMN(34)' 02370000 ADDRESS ISPEXEC 'DISPLAY PANEL(CLCPDSNI)' 02380000 ADDRESS ISPEXEC 'REMPOP' 02390000 CLCXMSG = 'Info' 02400000 ADDRESS ISPEXEC 'CONTROL DISPLAY RESTORE' 02410000 END 02420000 ELSE 02430000 DO 02440000 LONGERR = SUBSTR(SYSMSGLVL2,10,64) 02450000 CLCXMSG = 'Error' 02460000 ZMSG000L = LONGERR 02470000 ZMSG000S = 'ListDSI Error' 02480000 END; 02490000 END; 02500000 IF CLCXLCMD = 'M' THEN 02510000 DO; 02520000 LONGERR = ' "M" Line Command disabled.' 02530000 CALL REPOTABL 02540000 CLCXLCMD = ' ' 02550000 END; 02560000 IF CLCXLCMD /= ' ' THEN 02570000 DO; 02580000 CLCXMSG = SUBSTR('? 'CLCXLCMD' ',1,8) 02590000 CLCXLCMD = ' ' 02600000 LONGERR = 'Line command not recognized' 02610000 END; 02620000 X = OUTTRAP('SAVE.',0,'NOCONCAT') 02630000 ADDRESS ISPEXEC 'TBPUT 'TIOTTABL 02640000 IF ROWSELS > 0 THEN ADDRESS ISPEXEC 'TBDISPL 'TIOTTABL 02650000 END 02660000 END; 02670000 IF LENGTH(ZC01) = 0 THEN CALL REPOTABL 02680000 IF LENGTH(ZC01) > 0 THEN 02690000 DO 02700000 IF (ZC01 = 'COMMAND') | (ZC01 = 'COM') THEN 02710000 DO 02720000 ADDRESS ISPEXEC 'ADDPOP' 02730000 ADDRESS ISPEXEC 'DISPLAY PANEL(CLCPCOMH)' 02740000 ADDRESS ISPEXEC 'REMPOP' 02750000 END 02760000 ELSE 02770000 IF (ZC01 = 'FIND') | (ZC01 = 'F') THEN 02780000 DO 02790000 IF LENGTH(ZC02) > 0 THEN 02800000 DO 02810000 ADDRESS ISPEXEC 'TBTOP 'TIOTTABL 02820000 ADDRESS ISPEXEC 'TBSKIP 'TIOTTABL' NUMBER('ZTDTOP')' 02830000 DO WHILE RC = 0 02840000 X = INDEX(CLCXDSNM,ZC02) 02850000 IF X > 0 THEN RC = 1 02860000 ELSE 02870000 ADDRESS ISPEXEC 'TBSKIP 'TIOTTABL 02880000 IF RC = 8 THEN 02890000 DO 02900000 LONGERR = 'Text Not Found in DSNAME column' 02910000 KEEPCMD = 1 02920000 CALL REPOTABL 02930000 ZMSG000L = LONGERR 02940000 ZMSG000S = 'Text Not Found' 02950000 RC = 8 02960000 END 02970000 END 02980000 END 02990000 ELSE 03000000 DO 03010000 LONGERR = 'Missing parameter. FIND requires a parameter.' 03020000 KEEPCMD = 1 03030000 ZMSG000L = LONGERR 03040000 ZMSG000S = 'Missing Parameter' 03050000 CALL REPOTABL 03060000 END 03070000 END 03080000 ELSE 03090000 IF (ZC01 = 'REFRESH') | (ZC01 = 'REF') THEN 03100000 DO 03110000 ADDRESS ISPEXEC 'TBEND 'TIOTTABL 03120000 TITL = CENTER('TSO Session Allocations',25) 03130000 ADDRESS ISPEXEC 'SELECT PGM(CLCAGALC) PARM('TIOTTABL')' 03140000 END 03150000 ELSE 03160000 /* ------------------------------------------------------------ */ 03170000 /* Don't Use the Switch Command! It needs a downloaded TIOT */ 03180000 /* file from IDMS, CICS or DB2. Not ready to give that stuff */ 03190000 /* away. */ 03200000 /* ------------------------------------------------------------ */ 03210000 IF (ZC01 = 'SWITCH' ) | (ZC01 = 'SWI') THEN 03220000 DO 03230000 IF LENGTH(ZC02) > 0 THEN 03240000 DO 03250000 TIOTDSN = 'MOORE.'ZC02'.TIOT256' 03260000 IF SYSDSN(''''TIOTDSN'''') = 'OK' THEN 03270000 DO 03280000 SAVENAME = TIOTTABL 03290000 TIOTRND = RANDOM(1,100000); 03300000 TIOTTABL = SUBSTR('T'TIOTRND'00000000',1,8); 03310000 ADDRESS TSO "ALLOC DD(TIOTFILE) DA("''''TIOTDSN''''") SHR" 03320000 ADDRESS ISPEXEC 'SELECT PGM(CLCCCVDD) PARM('TIOTTABL')' 03330000 /* ADDRESS TSO "FREE DD(TIOTFILE)" */ 03340000 ADDRESS ISPEXEC 'VGET (CLCXSMFI,CLCXCVLN,CLCXCVRL,CLCXDMCL)' 03350000 ADDRESS ISPEXEC 'VGET (CLCXSYDD,CLCXJOBN,CLCXQCRE,CLCXQDWN)' 03360000 ADDRESS ISPEXEC 'VGET (CLCXSYDS,ZMSG000S,ZMSG000L)' 03370000 If ZMSG000S /= ' ' Then 03380000 DO 03390000 LONGERR = ZMSG000L 03400000 KEEPCMD = 1 03410000 TIOTTABL = SAVENAME 03420000 END 03430000 ELSE DO 03440000 ADDRESS ISPEXEC 'TBEND 'SAVENAME 03450000 TITL = CENTER(' 'CLCXCVLN 'Allocations',24) 03460000 ADDRESS ISPEXEC 'CONTROL DISPLAY SAVE' 03470000 ADDRESS ISPEXEC 'ADDPOP ROW(2) COLUMN(34)' 03480000 ADDRESS ISPEXEC 'DISPLAY PANEL(CLCPCVQI)' 03490000 ADDRESS ISPEXEC 'REMPOP' 03500000 ADDRESS ISPEXEC 'CONTROL DISPLAY RESTORE' 03510000 END 03520000 END 03530000 ELSE DO 03540000 LONGERR = 'Invalid or Missing TIOT DataSet-> 'TIOTDSN 03550000 KEEPCMD = 1 03560000 ZMSG000L = LONGERR 03570000 ZMSG000S = 'Missing TIOT Dataset' 03580000 END 03590000 END 03600000 ELSE DO 03610000 LONGERR = 'Missing parameter. SWITCH requires a parameter.' 03620000 KEEPCMD = 1 03630000 ZMSG000L = LONGERR 03640000 ZMSG000S = 'Missing Parameter' 03650000 CALL REPOTABL 03660000 END 03670000 END 03680000 ELSE 03690000 IF (ZC01 = 'LOCATE') | (ZC01 = 'LOC') | (ZC01 = 'L' ) THEN 03700000 DO 03710000 ADDRESS ISPEXEC 'TBTOP 'TIOTTABL 03720000 CLCXDDNM = ZC02 03730000 ADDRESS ISPEXEC 'TBSCAN 'TIOTTABL' ARGLIST(CLCXDDNM)' 03740000 IF RC /= 0 THEN 03750000 DO 03760000 LONGERR = 'DD name 'ZC02' not in TIOT' 03770000 KEEPCMD = 1 03780000 ZMSG000L = LONGERR 03790000 ZMSG000S = 'Missing DD Name' 03800000 CALL REPOTABL 03810000 END 03820000 END 03830000 ELSE 03840000 IF ZC01 = 'SEEK' THEN 03850000 DO 03860000 IF LENGTH(ZC02) = 0 | LENGTH(ZC03) = 0 THEN 03870000 DO 03880000 LONGERR = 'Missing parameters. SEEK requires DD Name & member' 03890000 KEEPCMD = 1 03900000 ZMSG000L = LONGERR 03910000 ZMSG000S = 'Missing DD Name' 03920000 CALL REPOTABL 03930000 END 03940000 IF LENGTH(ZC02) > 0 & LENGTH(ZC03) > 0 THEN 03950000 DO 03960000 ADDRESS ISPEXEC 'TBTOP 'TIOTTABL 03970000 IF ZC02 = 'ALL' THEN 03980000 DO 03990000 ADDRESS ISPEXEC 'TBSKIP 'TIOTTABL 04000000 END 04010000 ELSE 04020000 DO 04030000 CLCXDDNM = ZC02 04040000 ADDRESS ISPEXEC 'TBSCAN 'TIOTTABL' ARGLIST(CLCXDDNM)' 04050000 END 04060000 IF RC = 0 THEN 04070000 DO 04080000 T = 0 04090000 LONGERR = ZCMD 04100000 DO WHILE T = 0 04110000 ADDRESS ISPEXEC 'CONTROL DISPLAY SAVE' 04120000 IF ZC04 \= 'B' THEN 04130000 DO 04140000 ADDRESS ISPEXEC 'CONTROL NONDISPL END' 04150000 END; 04160000 CLCXMSG = '....No' 04170000 ADDRESS ISPEXEC "BROWSE DATASET('&CLCXDSNM(&ZC03)')" 04180000 IF RC = 0 THEN CLCXMSG = '...Yes' 04190000 ELSE 04200000 IF ZC04 \= 'B' THEN 04210000 DO 04220000 ADDRESS ISPEXEC 'DISPLAY PANEL(CLCPDSNI)'; 04230000 END; 04240000 ADDRESS ISPEXEC 'TBPUT 'TIOTTABL 04250000 ADDRESS ISPEXEC 'TBSKIP 'TIOTTABL 04260000 IF RC > 0 THEN T = 1 04270000 IF LENGTH(CLCXDDNM) > 0 & ZC02 /= 'ALL' THEN T = 1 04280000 ADDRESS ISPEXEC 'CONTROL DISPLAY RESTORE' 04290000 END 04300000 ADDRESS ISPEXEC 'TBTOP 'TIOTTABL 04310000 CLCXDDNM = ZC02 04320000 ADDRESS ISPEXEC 'TBSCAN 'TIOTTABL' ARGLIST(CLCXDDNM)' 04330000 END 04340000 ELSE 04350000 DO 04360000 LONGERR = 'DD Name' ZC02 'is not allocated' 04370000 KEEPCMD = 1 04380000 ZMSG000L = LONGERR 04390000 ZMSG000S = 'Missing DD Name' 04400000 CALL REPOTABL 04410000 END 04420000 END 04430000 END 04440000 ELSE 04450000 DO 04460000 LONGERR = 'Command' ZC01 'not recognized' 04470000 KEEPCMD = 1 04480000 ZMSG000L = LONGERR 04490000 ZMSG000S = 'Invalid Command' 04500000 CALL REPOTABL 04510000 END 04520000 END 04530000 END 04540000 RETCDE = 0 04550000 ADDRESS ISPEXEC 'TBEND 'TIOTTABL 04560000 ZREFMDE = HOLDMODE 04570000 ADDRESS ISPEXEC 'VPUT (ZREFMDE) PROFILE'; 04580000 /* ADDRESS ISPEXEC 'LIBDEF ISPPLIB' 04590000 ADDRESS ISPEXEC 'LIBDEF ISPLLIB' */ 04600000 EXIT RETCDE 04610000 /* ---Subroutines------------------------------------- */ 04620000 REPOTABL: ADDRESS ISPEXEC 'TBTOP 'TIOTTABL 04630000 ADDRESS ISPEXEC 'TBSKIP 'TIOTTABL' NUMBER('ZTDTOP') NOREAD' 04640000 RETURN 04650000