/* Rexx */
/* Reflection IBM 10.0.0 */
/* $Id: //ribm/12.0/dev/r8xfrind/wrqlcat.rex#1 $ */

Address TSO

Parse Arg LVL .
If LVL = "" Then
  LVL=UserID()

/*
   All messages are displayed twice, once in lowercase and once in
   uppercase. This is because lowercase characters could potentially be
   translated incorrectly on DBCS systems, causing the client component
   to not catch the message.  However, we don't want to display only the
   uppercase message because older versions of the client component look
   specifically for the lowercase characters.
*/

DatasetList.0 = 0
DatasetList.1 = "No Records Found"

/* alloc/listcat-ofile/execio/free is about 30% faster than outtrap */
'ALLOC FI(CATLIST) DEL SPACE(1,1) TRA BLKSIZE(23379) LRECL(125) RECFM(V,B,A)'
Call OutTrap 'ListcatMessages.'
"LISTCAT LEVEL('" || LVL || "') VOLUME NONVSAM OFILE(CATLIST)"
ListcRC=RC
Call OutTrap 'OFF'

If ListcRC>8 Then
  Do
    'FREE FI(CATLIST)'
    Say 'Processing complete: Level' LVL 'invalid. LISTCAT failed, rc='||ListcRC
    Say 'PROCESSING COMPLETE: LEVEL' LVL 'INVALID. LISTCAT FAILED, RC='||ListcRC
    Do Line=1 To ListcatMessages.0
      Say ListcatMessages.Line
    End
  End
Else
  Do
    'EXECIO * DISKR CATLIST (STEM ListcatOutput. FINIS)'
    'FREE FI(CATLIST)'

    If Pos('NOT FOUND',ListcatMessages.1) <> 0 Then
      Do
        Say "Processing complete: Level" LVL "was not found."
        Say "PROCESSING COMPLETE: LEVEL" LVL "WAS NOT FOUND."
      End
    Else
      Do
        Do Line=1 To ListcatOutput.0
          Parse Var ListcatOutput.Line EntryType . DatasetName .
          If EntryType = "0NONVSAM" Then
            Do
              Do While Pos('VOLSER',ListcatOutput.Line) = 0
                Line = Line+1
              End
              If Pos('MIGRAT',ListcatOutput.Line)=0 & ,
                 Pos('***',ListcatOutput.Line)=0 Then
                Do
                  DatasetList.0 = DatasetList.0 + 1
                  Entry=DatasetList.0
                  DatasetList.Entry=DatasetName
                End
            End
        End
        Say 'Processing Complete: ' || DatasetList.0 || ' items found'
        Say 'PROCESSING COMPLETE: ' || DatasetList.0 || ' ITEMS FOUND'
      End

    "ALLOC FI(TEMPD) NEW SP(1 1) TRA LRECL(80)",
          "RECFM(F B) BLKSIZE(8000) DELETE"
    "EXECIO * DISKW TEMPD (STEM DatasetList. OPEN FINIS"

    If ListDSI('TEMPD FILE') = 16 Then
      SysDSName=ListALC('TEMPD')

    Parse Upper Pull TransferCommand 'WRQTEMP.DAT' TransferOptions

    TransferCommand "'"||SysDSName||"'" TransferOptions
    "FREE FI(TEMPD)"
  End

Return

ListAlc: Procedure

Call OutTrap 'ListAlcOutput.'
'LISTA ST SYSNAMES'
Call OutTrap 'OFF'

Do MessageLine=1 To ListAlcOutput.0 ,
 Until Pos(Arg(1),ListAlcOutput.MessageLine) = 3
End

MessageLine=MessageLine-1

Return Strip(ListAlcOutput.MessageLine)
