/*--                             REXX             G.FOGG            --*/
/*---------------------------------+----------------------------------*/
/* THIS EXEC WILL ONLY LIST CDT ENTRIES FROM THE STATIC CNST TABLE.   */
/* IT WILL SHOW THE CLASS NAME, POSIT VALUE, IF CLASS IS ACTIVE,      */
/* GENERICS ALLOWED OR NOT, GENERIC AND GENCMD ACTIVE OR NOT.         */
/*TRACE R?*/
NUMERIC DIGITS 10
OFFSET  = 0                      /* USED AS OFFSET TO NEXT CNST ENTRY */
CVTP  = C2D(STORAGE('0010',4))      /* CVTP:       CVT ADDRESS        */
RCVT  = $ADDC(CVTP,'3E0')           /* X'3EO' = ADDRESS OF RCVT       */
RCVTFLG3 = STORAGE(D2X(RCVT + 633),1)  /*TEST IF DYNAMIC CDT ENABLED  */
SAY "STATIC CDT ENTRIES ARE:"
SAY " "
CNT = 0
GROUP =
CNDT  = $ADDC(RCVT,'0BC')           /* X'3EO' = ADDRESS OF 1ST CNST   */
DO FOREVER
  CNT = CNT + 1                     /* GET ONE 28 BYTE CNST ENTRY     */
  CNST  = STORAGE(D2X(CNDT+OFFSET),28)
  CNSTLGT = C2D(STORAGE(D2X(CNDT+OFFSET),2))
  /*LENGTH OF THIS CNST ENTRY   */
  IF CNSTLGT = 0 THEN LEAVE         /*IF 0 THEN NO MORE CNST ENTRIES  */
  CNSTID = C2D(SUBSTR(CNST,3,1))    /* GET CLASS ID                   */
  CNSTNAME =    SUBSTR(CNST,4,8)    /* CNSTNAME NAME OF RESOURCE CLASS*/
  CNSTXREF =    SUBSTR(CNST,12,8)   /* CNSTXREF NAME OF RESOURCE CLASS*/
  CNSTFRST =    SUBSTR(CNST,21,1)   /* CNSTFRST NAME OF RESOURCE CLASS*/
  CNSTREMN =    SUBSTR(CNST,22,1)   /* CNSTREMN NAME OF RESOURCE CLASS*/
  CNSTUACC =    SUBSTR(CNST,23,1)   /* CNSTUACC NAME OF RESOURCE CLASS*/
  CNSTMFLG =    SUBSTR(CNST,24,1)   /* CNSTMFLG NAME OF RESOURCE CLASS*/
/* GET THE ADDRESS OF THE CNST EXTENSION (CNSX) AND RETRIEVE DATA     */
  CNSX = STORAGE(C2X(SUBSTR(CNST,25,4)),152)    /*ADDRESS OF CNSX   */
  VMSK = SUBSTR(CNSX,1,128)       /*1ST 128 BYTES IS CNXT LONG MASK */
  CNSTFLG1 = SUBSTR(CNSX,141,1)                     /*CNSTCNSTFLG1 BYTE */
  CNSTFLG0 = SUBSTR(CNSX,138,1)               /* HEC1 CNSTFLG0 BYTE */
  IF BITAND(CNSTMFLG,'80'X) = '80'X THEN ,
    GROUP = GROUP"#"CNSTNAME
  SAY RIGHT(CNT,4,0) CNSTNAME,
      " CNSTFRST="C2X(CNSTFRST),
      " CNSTREMN="C2X(CNSTREMN),
      " CNSTUACC="C2X(CNSTUACC),
      " CNSTMFLG="C2X(CNSTMFLG),
      " CNSTFLG0="C2X(CNSTFLG0) "CNSTFLG1="C2X(CNSTFLG1)
  OFFSET = OFFSET + 28              /* POINT TO NEXT CNST ENTRY       */
END                                        /* END OF "DO FOREVER LOOP */
 
/*                TEST TO SEE IF DYNAMIC CDT ENABLED                  */
IF BITAND(RCVTFLG3,'80'X) = '80'X THEN DO
  SAY" "
  SAY"DYNAMIC CDT ENTRIES LISTED BELOW"
  SAY " "
/*"RL CDT * CDTINFO"*/
  X = OUTTRAP("LINE.")
  "RL CDT * NOR CDTINFO"
  DO A = 1 TO LINE.0
    SAY LINE.A
    IF POS("CDT     ",LINE.A) <> 0 THEN,
      CNSTNAME = WORD(LINE.A,2)
    PARSE VAR LINE.A "MEMBER = " TEXT
    PARSE VAR LINE.A "GROUP = " TEXT1
    IF TEXT >= 'A' THEN,
      GROUP = GROUP"#"LEFT(CNSTNAME,8)
    IF TEXT1 >= 'A' THEN,
      GROUP = GROUP"#"LEFT(CNSTNAME,8)
    END
  END
ELSE DO
  SAY" "
  SAY "DYNAMIC CDT NOT ENABLED"
  END
ADDRESS ISPEXEC "VPUT (GROUP) ASIS"
EXIT
/**********************************************************************/
$ADDC:ARG AD1,AD2
RETURN C2D(STORAGE(D2X(AD1+X2D(AD2)),4))
/**********************************************************************/