.title	'Find Rights Held By Process'

EXTERNAL FUNCTION
	SYS$GETJPIW	,%VAL

EXTERNAL FUNCTION
	SYS$FIND_HELD	,%VAL

EXTERNAL FUNCTION
	SYS$IDTOASC	,%VAL

	.page
.include	'$JPIDEF'	library 'sys$library:dblstarlet'
	.page
.include	'$SSDEF'	library 'sys$library:dblstarlet'
	.page
RECORD
	GROUP	ITEM_LIST,[4]A
		BUFF_LENGTH	,I2
		ITEM_CODE	,I2
		BUFFER_ADDR	,I4
		RETURN_LENGTH	,I4
	ENDGROUP
	END_OF_LIST		,I4

RECORD
BILLING		,A6,'BILLNG'
RET_PID		,I4	;PROCESS IDENTIFICATION
RET_UIC		,I4	;UIC RETURNED FROM GETJPIW
CONTEXT		,I2	;CONTEXT VALUE
RIGHTS_ID	,I4	;IDENTIFIER RETURNED
STATUS		,I4	;STATUS OF CALL
IOSB		,[4]I2	;I/O STATUS BLOCK

RECORD	IDTOASC
ZERO		,I4,0	;INITIALIZE TO ZERO
TWO		,I4,2	;INITIALIZE TO TWO
NAMLEN		,I2	;LENGTH OF NAME RETURNED IN NAMBUF
NAMBUF		,A255	;ASCII TEXT STRING OF RIGHTS IDENTIFIER
RESID		,I4	;RESOURCE IDENTIFIER
ATTRIB		,I4	;ATTRIBUTES OF IDENTIFIER
ICONTEXT	,I4	;CONTEXT ARGUMENT

RECORD
HOLDER		,I8

RECORD	,X
UIC		,I4	;LONGWORD UIC
PAD		,I4	;PAD WITH ZERO

	PROC

	item_list[1].buff_length=%size(RET_UIC)
	item_list[1].item_code=JPI$_UIC
	item_list[1].buffer_addr=%addr(RET_UIC)
	item_list[1].RETURN_LENGTH=zero

	item_list[2].buff_length=%size(RET_PID)
	item_list[2].item_code=JPI$_PID
	item_list[2].buffer_addr=%addr(RET_PID)
	item_list[2].RETURN_LENGTH=zero

	end_of_list = zero

	status = %sys$getjpiw (,,,%ref(item_list),%REF(iosb),,)

	if (.not.%success(status)) xcall lib$stop(%val(iosb[1]))

	uic = ret_uic
	pad = zero
	context = zero
	icontext = zero

loop,

	clear rights_id
	status = %sys$find_held (%ref(holder)
&				,%ref(rights_id)
&				,
&				,%ref(context))
	if (status .eq. ss$_nosuchid) goto no_more

translate,

	clear namlen
	clear nambuf
	clear resid
	clear attrib
	status = %sys$idtoasc (%val(rights_id)
&				,%ref(namlen)
&				,nambuf
&				,%ref(resid)
&				,%ref(attrib)
&				,%ref(icontext))
	if (nambuf .eq. billing) goto no_more
	goto loop
no_more,
	stop status