/* REXX */                                                                      
/*                                       */                                     
/* AUTHOR: Mark Zelden                   */                                     
/*                                       */                                     
/* Last update:  06/18/2012              */                                     
/*****************************************************************/             
/*  XMEMLIST - MEMLIST a data set from anywhere.                 */             
/*                                                               */             
/*  Best used when set up in the ISPF command table with an      */             
/*  abbreviation of "XM".                                        */             
/*    VERB      T   ACTION                                       */             
/*    XMEMLIST  2   SELECT CMD(%XMEMLIST &ZPARM) NEWAPPL(ISR)    */             
/*                                                               */             
/*  Fully qualified data set names are now optional, regardless  */             
/*  of the TSO PROFILE PREFIX setting. PREFIX.DATA.SET.NAME will */             
/*  be tried first, then DATA.SET.NAME for data sets that are    */             
/*  not fully qualified.                                         */             
/*                                                               */             
/*****************************************************************/             
/* COMMAND SYNTAX:                                               */             
/*                                                               */             
/*  XM DATA.SET.NAME  <volser>    (VOLSER is optional)           */             
/*                                                               */             
/*  XM 'MY.PDS(ABC*)'                                            */             
/*  XM PDS.NOTCAT USER01                                         */             
/*                                                               */             
/*  If not set up as an ISPF command, then you can still         */             
/*  invoke the exec by typing:   TSO %XMEMLIST DATA.SET.NAME     */             
/*****************************************************************/             
Parse UPPER ARG DSN VOL                                                         
                                                                                
If DSN= '' then do                          /* no DSN specified      */         
  say 'Please enter positional parameter dsn -' /* prompt for dsn    */         
  parse upper pull DSN                      /* get dsn response      */         
End                                                                             
                                                                                
Address ISPEXEC                                                                 
"CONTROL ERRORS RETURN"                                                         
junk = MSG(off)                                                                 
                                                                                
MEMSTART = Pos('(',DSN)                                                         
If MEMSTART <> 0 then do                                                        
  MEMEND = Pos(')',DSN)                                                         
  XMEM   = Substr(DSN,MEMSTART+1,MEMEND-MEMSTART-1)                             
  DSN    = Substr(DSN,1,MEMSTART-1)                                             
  If Pos("'",DSN) <> 0 then DSN = DSN || "'"                                    
End                                                                             
 Else XMEM = ''                                                                 
                                                                                
                                                                                
"VGET ZENVIR"                              /* get ISPF version      */          
XIVER1 = Substr(ZENVIR,6,1)                /* only need 1 char      */          
"VGET ZPCFMCN PROFILE"                                                          
If ZPCFMCN = '/' then CONF = 'YES'                                              
 Else CONF = 'NO'                                                               
                                                                                
"LMINIT DATAID("XMEMD1") DATASET("DSN") VOLUME("VOL")"                          
RCSV = RC                                                                       
If RCSV <> 0 then do                                                            
   If Pos("'",DSN) <> 0 then QUOTES = 'Y'   /* need to know for later*/         
   DSN =  Strip(Translate(DSN,"","'"))      /* remove quotes if used */         
   "LMINIT DATAID("XMEMD1") DATASET('"DSN"') VOLUME("VOL")"                     
   RCSV = RC                                                                    
   If RCSV <> 0 then do                                                         
     "SETMSG MSG("ZERRMSG")"                /* not found - issue msg */         
     Exit RCSV                                                                  
   End                                                                          
   Else if QUOTES <> 'Y' then DSN = "'" || DSN || "'"  /* add quotes */         
End                                                                             
If RCSV = 0 then do                                                             
  "LMOPEN DATAID("XMEMD1")"                                                     
  RCSV = RC                                                                     
  If RCSV = 0 then do                                                           
    ZLLCMD   = ''                                                               
    ZLMEMBER = ''                                                               
    ZLUDATA  = ''                                                               
    CURLOC   = 'ZLLCMD'                                                         
    "LMMDISP DATAID("XMEMD1") COMMANDS(ANY) MEMBER("XMEM")"                     
    RCSV = RC                                                                   
    Do while RCSV = 0                                                           
      If ZLLCMD = 'B' then do                                                   
        "BROWSE DATAID("XMEMD1") MEMBER("ZLMEMBER")"                            
        CC = RC                                                                 
        UD = '*BROWSED'                                                         
        If CC <> 0 then "SETMSG MSG("ZERRMSG")"                                 
      End                                                                       
      Else if ZLLCMD = '/' & XIVER1 >= 4 then do                                
        "BROWSE DATAID("XMEMD1") MEMBER("ZLMEMBER")"                            
        CC = RC                                                                 
        UD = '*BROWSED'                                                         
        If CC <> 0 then "SETMSG MSG("ZERRMSG")"                                 
      End                                                                       
      Else if ZLLCMD = 'V' & XIVER1 >=4 then do                                 
        "VIEW DATAID("XMEMD1") MEMBER("ZLMEMBER")" ,                            
               "CONFIRM("CONF")"                                                
        CC = RC                                                                 
        UD = '*VIEWED'                                                          
        If CC <> 0 then "SETMSG MSG("ZERRMSG")"                                 
      End                                                                       
      Else if ZLLCMD = 'E' & XIVER1 >=4 then do                                 
        EDITOK = 'NOTOK'                                                        
        Do while EDITOK = 'NOTOK'                                               
          "EDREC QUERY"                                                         
          If RC = 4 then do                                                     
            "DISPLAY PANEL(ISREDM02)"                                           
            DISPRC = RC                                                         
            "VGET ZVERB"                                                        
             If DISPRC = 0 then do                                              
               If ZEDCMD = '' then "EDREC PROCESS PASSWORD(" || PSWD || ")"     
               If ZEDCMD = 'C' then "EDREC CANCEL"                              
               If ZEDCMD = 'D' then "EDREC DEFER"                               
             End                                                                
             Else if DISPRC = 8 & ZVERB = 'CANCEL' then "EDREC CANCEL"          
             Else EXIT 0                                                        
          End                                                                   
          Else EDITOK = 'OK'                                                    
        End                                                                     
        RC = 0                                                                  
        "EDIT DATAID("XMEMD1") MEMBER("ZLMEMBER")" ,                            
               "CONFIRM("CONF")"                                                
        CC = RC                                                                 
        UD = '*EDITED'                                                          
        If CC = 4 then CC = 0                                                   
        If CC <> 0 then "SETMSG MSG("ZERRMSG")"                                 
      End /* Else if ZLLCMD = 'E' & XIVER1 >=4 */                               
      Else if ZLLCMD = 'E' & XIVER1 < 4 then do                                 
        EDITOK = 'NOTOK'                                                        
        Do while EDITOK = 'NOTOK'                                               
          "EDREC QUERY"                                                         
          If RC = 4 then do                                                     
            "DISPLAY PANEL(ISREDM02)"                                           
            DISPRC = RC                                                         
            "VGET ZVERB"                                                        
             If DISPRC = 0 then do                                              
               If ZEDCMD = '' then "EDREC PROCESS PASSWORD(" || PSWD || ")"     
               If ZEDCMD = 'C' then "EDREC CANCEL"                              
               If ZEDCMD = 'D' then "EDREC DEFER"                               
             End                                                                
             Else if DISPRC = 8 & ZVERB = 'CANCEL' then "EDREC CANCEL"          
             Else EXIT 0                                                        
          End                                                                   
          Else EDITOK = 'OK'                                                    
        End                                                                     
        RC = 0                                                                  
        "EDIT DATAID("XMEMD1") MEMBER("ZLMEMBER")"                              
        CC = RC                                                                 
        UD = '*EDITED'                                                          
        If CC = 4 then CC = 0                                                   
        If CC <> 0 then "SETMSG MSG("ZERRMSG")"                                 
      End /* Else if ZLLCMD = 'E' & XIVER1 < 4 */                               
      Else if ZLLCMD = 'P' then do                                              
        "LMPRINT DATAID("XMEMD1") MEMBER("ZLMEMBER")"                           
        CC = RC                                                                 
        UD = '*PRINTED'                                                         
        If CC <> 0 then "SETMSG MSG("ZERRMSG")"                                 
      End                                                                       
      Else if ZLLCMD = 'R' then do                                              
        "LMINIT DATAID(XMEMD2) DATASET("DSN")" ,                                
            "ENQ(SHRW) VOLUME("VOL")"                                           
        RCSV = RC                                                               
        If RCSV = 0 then do                                                     
          "LMOPEN DATAID("XMEMD2") OPTION(OUTPUT)"                              
          CC = RC                                                               
          If CC = 0 then do                                                     
            "LMMREN DATAID("XMEMD2") MEMBER("ZLMEMBER")" ,                      
                "NEWNAME("ZLUDATA")"                                            
             CC = RC                                                            
             If ZLUDATA = '' then do                                            
               ZERRMSG = 'ISRU003'                                              
               CURLOC  = 'ZLUDATA'                                              
             End                                                                
            UD = '*RENAMED'                                                     
            "LMCLOSE DATAID("XMEMD2")"                                          
          End                                                                   
          "LMFREE DATAID("XMEMD2")"                                             
        End                                                                     
      End  /* if ZLLCMD = 'R' */                                                
      Else if ZLLCMD = 'D' then do                                              
        "LMINIT DATAID(XMEMD2) DATASET("DSN")" ,                                
          "ENQ(SHRW) VOLUME("VOL")"                                             
        RCSV = RC                                                               
        If RCSV = 0 then do                                                     
          "LMOPEN DATAID("XMEMD2") OPTION(OUTPUT)"                              
          CC = RC                                                               
          If CC = 0 then do                                                     
            "VGET ZMEMCONF"                                                     
            If ZMEMCONF <> 'OFF' then do                                        
              ZCFDSN = Strip(Translate(DSN,"","'"))                             
              ZCFMEM = ZLMEMBER                                                 
              UD = ''                                                           
              "ADDPOP"                                                          
              "DISPLAY PANEL(ISRUDELC)"                                         
              DISPRC = RC                                                       
              If DISPRC = 0 then do                                             
                "LMMDEL DATAID("XMEMD2") MEMBER("ZLMEMBER")"                    
                CC = RC                                                         
                UD = '*DELETED'                                                 
              End                                                               
              "REMPOP"                                                          
            End /* if ZMEMCONF = */                                             
            Else Do                                                             
              "LMMDEL DATAID("XMEMD2") MEMBER("ZLMEMBER")"                      
              CC = RC                                                           
              UD = '*DELETED'                                                   
            End                                                                 
            "LMCLOSE DATAID("XMEMD2")"                                          
          End                                                                   
          "LMFREE DATAID("XMEMD2")"                                             
        End  /* if RCSV = 0 */                                                  
      End  /* if ZLLCMD = 'D' */                                                
      Else do                                                                   
        If ZCMD <> '' then do                                                   
          ZEDSMSG = 'Invalid command'                                           
          ZEDLMSG = 'Valid member list commands are',                           
                    '"SELECT", "SORT", "LOCATE", "RESET"' ,                     
                        'and "SAVE".'                                           
          ZERRMSG = 'ISRZ001' /* MSG - WITH ALARM */                            
          CURLOC  = 'ZCMD'                                                      
        End                                                                     
        Else do                                                                 
          ZEDSMSG = 'Invalid selection code'                                    
          If XIVER1 < 4 then ,                                                  
            ZEDLMSG = 'Codes are: E (Edit),' ,                                  
                          'B (Browse),' ,                                       
                          'R (Rename), D (Delete),' ,                           
                          'P (Print).'                                          
          Else ,                                                                
            ZEDLMSG = 'Valid codes: E (Edit),',                                 
                          'B (Browse), V (View),' ,                             
                          'R (Rename), D (Delete),' ,                           
                          'P (Print).'                                          
          ZERRMSG = 'ISRZ001' /* MSG - WITH ALARM */                            
          CURLOC  = 'ZLLCMD'                                                    
        End                                                                     
      CC = 4   /* init non zero CC for next selection */                        
      End                                                                       
      If CC = 0 then do                                                         
        "LMMDISP DATAID("XMEMD1") OPTION(PUT)" ,                                
          "MEMBER("ZLMEMBER") ZLUDATA("UD")"                                    
        "LMMDISP DATAID("XMEMD1") OPTION(GET)"                                  
        RCSV = RC                                                               
        If RCSV = 8 then do                                                     
          "LMMDISP DATAID("XMEMD1") COMMANDS(ANY)"                              
          RCSV = RC                                                             
        End                                                                     
      End                                                                       
      Else do                                                                   
        "SETMSG MSG("ZERRMSG")"                                                 
        "LMMDISP DATAID("XMEMD1") OPTION(PUT)" ,                                
          "MEMBER("ZLMEMBER") ZLLCMD("ZLLCMD") ZLUDATA("ZLUDATA")"              
        "LMMDISP DATAID("XMEMD1") COMMANDS(ANY)" ,                              
          "CURSOR("CURLOC") TOP("ZLMEMBER")"                                    
        RCSV = RC                                                               
      End                                                                       
    End /* do while RC=0 */                                                     
    If RCSV = 8 then RCSV = 0                                                   
    "LMMDISP DATAID("XMEMD1") OPTION(FREE)"                                     
    If Translate(ZERRSM) = 'NO MEMBER LIST' then do                             
      If Pos('*',XMEM) > 0 | Pos('%',XMEM) > 0 then do                          
        ZEDSMSG = 'No matches'                                                  
        ZEDLMSG = 'Member name pattern' XMEM 'produced' ,                       
                      'no matching members.'                                    
        ZERRMSG = 'ISRZ001' /* MSG - WITH ALARM */                              
      End                                                                       
      Else do                                                                   
        ZEDSMSG = 'Member not found'                                            
        ZEDLMSG = 'Member' XMEM 'was not found in the' ,                        
                     'PDS directory.'                                           
        ZERRMSG = 'ISRZ001' /* MSG - WITH ALARM */                              
      End                                                                       
    End                                                                         
    If Translate(ZERRSM) = 'DATA SET NOT PARTITIONED' then do                   
      ZEDSMSG = 'Invalid DSORG'                                                 
      ZEDLMSG = DSN 'organization must be' ,                                    
                    'partitioned.'                                              
      ZERRMSG = 'ISRZ001' /* MSG - WITH ALARM */                                
    End                                                                         
    "LMCLOSE DATAID("XMEMD1")"                                                  
  End                                                                           
  "LMFREE DATAID("XMEMD1")"                                                     
End                                                                             
If RCSV <> 0 then "SETMSG MSG("ZERRMSG")"                                       
Exit RCSV