PARTNAME exec: show a set of parts with a similar name

The following PARTNAME exec code is used to show parts with similar names.

/* REXX EXEC TO SHOW ALL PARTS WITH A NAME CONTAINING A STRING  */
/* Designed to be run by the IVPREXX exec with PSB=DFSSAM02     */
/* Syntax:   IVPREXX PARTNAME string <#parts>                   */
 
Arg  PartName Segs .
Address REXXIMS
Term    ='IOPCB'      /* PCB Name */
DataBase='DBPCB01'    /* PCB Name for Parts Database */
 
Call SayIt 'IMS Parts DATABASE Transaction'
Call SayIt 'System Date:' Date('U') '   Time:' Time()
Call Sayit ' '
 
If ¬DataType(Segs,'W') & Segs¬='*' then Segs=5
If PartName='' then Do
   Call Sayit 'Please supply the first few characters of the part name'
   Exit 0
End
 
Call Sayit 'Request: Display' Segs 'Parts with Part Name like' PartName
SSA1='PARTROOT '
'GU DATABASE ROOT_SEG SSA1'
Status=REXXIMS('STATUS')
i=0
Do While RC=0 & (i<Segs | Segs='*')
   Parse Var Root_Seg 3 PNum 18 27 Description 47
   'GN DATABASE ROOT_SEG SSA1'
   Status=REXXIMS('STATUS')
   If RC¬=0 & Status¬='GB' Then Leave
   If Index(Description,PartName)=0 then Iterate
   i=i+1
   Call Sayit Right(i,2)') Part='PNum ' Desc='Description
End
If RC¬=0 & Status¬='GB' Then Signal BadCall
If i<Segs & Segs¬='*' then
   Call SayIt 'End of DataBase reached before' Segs 'records shown.'
Call Sayit ' '
Exit 0
 
SayIt: Procedure Expose Term
   Parse Arg Msg
   'ISRT Term MSG'
   If RC¬=0 then Signal BadCall
Return
 
BadCall:
   Call "DFSSUT04" Term
Exit 99