PARTNUM exec: show set of parts near a specified number

PARTNUM exec: show set of parts near a specified number

/* REXX EXEC TO SHOW A SET OF PARTS NEAR A SPECIFIED NUMBER    */
/* Designed to be run by the IVPREXX exec with PSB=DFSSAM02    */
/* Syntax:    IVPREXX PARTNUM string <start#>                  */
 
Address REXXTDLI
IOPCB='IOPCB'      /* PCB Name */
DataBase='#2'      /* PCB # */
RootSeg_Map = 'PNUM C 15 3 : DESCRIPTION C 20 27'
'MAPDEF ROOTSEG ROOTSEG_MAP'
Call SayIt 'IMS Parts DATABASE Transaction'
Call SayIt 'System Date:' Date('U') '   Time:' Time()
Call Sayit ' '
 
Arg  PartNum Segs .
If ¬DataType(Segs,'W') then Segs=5  /* default view amount */
 
PartNum=Left(PartNum,15)    /* Pad to 15 with Blanks */
If PartNum='' then
  Call Sayit 'Request: Display first' Segs 'Parts in the DataBase'
Else
  Call Sayit 'Request: Display' Segs 'Parts with Part_Number >=' PartNum
SSA1='PARTROOT(PARTKEY >=02'PartNum')'
'GU DATABASE *ROOTSEG SSA1'
Status=IMSQUERY('STATUS')
If Status='GE' then Do /* Segment Not Found */
   Call Sayit 'No parts found with larger Part_Number'
   Exit 0
End
Do i=1 to Segs While Status='  '
   Call Sayit Right(i,2) 'Part='PNum ' Desc='Description
   'GN DATABASE *ROOTSEG SSA1'
   Status=IMSQUERY('STATUS')
End
If Status='GB' then
   Call SayIt 'End of DataBase reached before' Segs 'records shown.'
Else If Status¬='  ' then Signal BadCall
Call Sayit ' '
   Exit 0
 
SayIt: Procedure  Expose IOPCB
   Parse Arg Msg
   'ISRT IOPCB MSG'
   If RC¬=0 then Signal BadCall
Return
 
BadCall:
   'DLIINFO INFO'
   Parse Var Info Call PCB . . . . Status .
   Msg = 'Unresolved Status Code' Status,
      'on' Call 'on PCB' PCB
   'ISRT IOPCB MSG'
Exit 99