/* REXX */ /*THIS VERSION DOES NOT USE MODEL*/
/*--------------------------------------------------------------------*
   BROWSE THROUGH ALL TCBS AND GET ID, SCRNAME, PANELID, APPLICATION
*--------------------------------------------------------------------*/
/* REXX */
ADDRESS ISPEXEC "CONTROL ERRORS RETURN"
SIGNAL ON ERROR
SIGNAL ON SYNTAX

/* GET ISPMAIN PARENT TASK TCB ---------------------------         */
PSATOLD = PTR(X2D('21C'))           /* GET CURRENT LEVEL REXX TCB  */
TCBCURR = PTR(PSATOLD + X2D('84'))  /* GO UP ONE LEVEL             */
TCBOTC  = PTR(TCBCURR + X2D('84'))  /* GO UP ANOTHER LEVEL         */
TCBLTC  = PTR(TCBOTC  + X2D('88'))  /* GET THE FIRST CHILD TASK...
                                       ...ATTACHED BY THIS TASK    */

/* LOOP FOR ALL ISPF TCBS AND GET SCREEN INFO ------------         */
TCB = TCBLTC
I   = 0
DO WHILE (TCB /= 0)
   SAY D2X(TCB)
   I = I + 1
   CALL GETSCREENINFO(TCB)
   TCB = PTR(TCB + X2D('80'))          /* READ SAME LEVEL NEXT TCB */
END
TCB = TCBLTC
I   = 0
DO WHILE (TCB /= 0)
   SAY D2X(TCB)
   I = I + 1
   CALL GETSCREENINFO(TCB)
   TCB = PTR(TCB + X2D('80'))          /* READ SAME LEVEL NEXT TCB */
END
/* CREATE THE * AND - BEFORE TLDID         ----------------------- */
IF DATATYPE(CURRALTID,'N') THEN DO /* DO ALT FIRST AS FOR ONLY 1   */
    I = SAVE.CURRALTID             /* TLDID, CURRENT = ALT         */
    J = CURRALTID !! "-"
    INTERPRET "ZTLDID"I    " =  J"
END
IF DATATYPE(CURRTLDID,'N') THEN DO
    I = SAVE.CURRTLDID
    J = CURRTLDID !! "*"
    INTERPRET "ZTLDID"I    " =  J"
END

/* DISPLAY SWAP SCREEN ----------------------------------- */
ADDRESS ISPEXEC "ADDPOP"
ADDRESS ISPEXEC "DISPLAY PANEL(HSPSLIST)"
ADDRESS ISPEXEC "REMPOP"
/* PROCESS COMMAND ENTERED ------------------------------- */
SELECT
   WHEN (RSEL>0)&(RSEL<9) THEN DO
      TEMPSTR = " NUM = ZTLDID" !! SUBSTR(RSEL,2,1)
      INTERPRET TEMPSTR
      CMD = "SWAP " !! SUBSTR(NUM,1,1)
      ADDRESS ISPEXEC "DISPLAY COMMAND(CMD)"
   END
   WHEN (RSEL="NA") THEN DO
      ADDRESS ISPEXEC "SELECT PGM(ISPSTRT) PARM("ZNEWP")"
   END
   WHEN (RSEL="NS") THEN DO
      ADDRESS ISPEXEC "SELECT PGM(ISPSTRT)"
   END
   OTHERWISE
END
/* EXIT -------------------------------------------------- */
EXIT:
SIGNAL OFF ERROR
EXIT   0

/* SUBROUTINES ------------------------------------------- */
ERROR:
  CALL   EXIT
  SAY "SORRY MATE. ERROR="RC" CMD="CMD
  CALL   EXIT

PTR:   RETURN C2D(STORAGE(D2X(ARG(1)),4))

STG:   RETURN STORAGE(D2X(ARG(1)),ARG(2))

GETSCREENINFO:
   TEMP  = PTR(ARG(1) + X2D('70'))
   TEMP  = PTR(TEMP + X2D('18'))
   TLD   = PTR(TEMP + 0)
   TLDID = STG(TLD + 3, 1)                            /* OUTPUT */
   ALTID = STG(PTR(TLD + 4) + 3 , 1)                  /* OUTPUT */
   APPID = STG(PTR(TLD + X2D('78')) + X2D('70'), 8)   /* OUTPUT */
   TRACE I
   PANELID    = STG(TLD + X2D('158'), 8)              /* OUTPUT */
   TRACE O
   SCRNAME    = STG(TLD + X2D('354'), 8)              /* OUTPUT */
   SCREENAREA = STG(PTR(TLD + X2D('60')), 80*5)
   DSNAME     = ""

   /* SAVE INFO TO SHOW * AND - */
   SAVE.TLDID = I
   IF ARG(1) = TCBCURR THEN
   DO
       CURRTLDID = TLDID
       CURRALTID = ALTID
   END

   /* IN EDIT/VIEW/BROSWSE SCREEN OR MEMBER LIST SCREEN */
   IF (PANELID="ISREDDE2")!(PANELID="ISRUDSM")
   THEN DO
      POS1 = POS("COMMAND ===>",TRANSLATE(SCREENAREA))  - 80 + 10
      DSNAME = SUBSTR(SCREENAREA,POS1,50)
      PARSE VAR DSNAME DSNAME .
      DSNAME = SUBSTR(DSNAME,2)
   END

   /* IN 3.4 LIST */
   IF PANELID="ISRUDSL0"
   THEN DO
      POS1 = POS("DATA SETS MATCHING ",TRANSLATE(SCREENAREA)) + 18
      DSNAME = SUBSTR(SCREENAREA,POS1,50)
      PARSE VAR DSNAME DSNAME .
   END

   /* PUT INTO VARIABLES NOW .. USE THE TLDID TO PUSH INTO VARAIBLES*/
   INTERPRET "ZTLDID"I    " = TLDID "
   INTERPRET "ZSCRNM"I    " = SCRNAME "
   INTERPRET "ZPANID"I    " = PANELID "
   INTERPRET "ZAPPID"I    " = APPID "
   INTERPRET "ZSESTZ"I    " = LEFT(DSNAME,LENGTH(DSNAME)) "
RETURN 0 ;

SYNTAX:
   SAY RC ERRORTEXT(RC)
   SAY SIGL "-" SOURCELINE(SIGL)
   TRACE ?R
   NOP
   EXIT