.title	'Stop Process Utility'
;
;
;		S T O P R O . D B L
;
;
;		This Utility will force a process to exit
;		execution of current image and return to
;		command level ($).
;
;	Ver/Edit	 Edit Date	By	Reason
;
;	V1.0-00A
;
;
	.page
.include "$JPIDEF" library "SYS$LIBRARY:DBLSTARLET"
	.page
.include "$SYIDEF" library "SYS$LIBRARY:DBLSTARLET"
	.page
EXTERNAL LITERAL
	STP_SUCCESS	,I4

EXTERNAL FUNCTION
	LIB$SIGNAL	,%VAL

EXTERNAL FUNCTION
	OTS$CVT_TZ_L	,%VAL

EXTERNAL FUNCTION
	SYS$FORCEX	,%VAL

EXTERNAL FUNCTION
	SYS$GETJPIW	,%VAL

EXTERNAL FUNCTION
	SYS$GETSYIW	,%VAL

RECORD
	GROUP	Item_List	,[5]A
		Buff_Length		,I2
		Item_Code		,I2
		Buffer_Addr		,I4
		Return_Length		,I4
	ENDGROUP
	End_Of_List			,I4

RECORD	SEARCH
SEARCH_PROCESS_ID	,I4		;Will verify existence of this PID.
SEARCH_PROC_NAME	,A15		;Process Name returned from Search.
SEARCH_USER_NAME	,A12		;User Name returned from Search.
SEARCH_TERM_NAME	,A7		;Terminal Name returned from Search.
SEARCH_NODE_NAME	,A15		;Node Name returned from Search.
SEARCH_IMAGE_NAME	,A39		;Image Name returned from Search.
	.page
RECORD
ZERO		,I4,0		;Longword Zero
PID		,A8		;Process Id Entered.
INT_PID		,I4		;Integer representation of "PID"
INT_PID_LENGTH	,I4		;Length of Integer PID value returned.
PROCESS_NAME	,A15		;Process Name.
COND_VALUE	,I4		;Conditional Value Returned.
CHAIN		,A39		;Process to chain to from this utility (Optional).
BLANK		,A39		;Blank for compares.
STATUS		,I4		;Status of Forced Exit Call.
RESPONSE	,A1		;Response Entered by User.
LOOP		,D3		;Increment for loop control.
PROC_ID		,A8		;Process ID.
PROC_NAME	,A15		;Process Name.
USER_NAME	,A12		;User Name.
TERM_NAME	,A7		;Terminal Name.
NODE_NAME	,A15		;Process Name.
IMAGE_NAME	,A39		;Image Name.
STAT		,I4		;Status Value of External Call.
IOSB		,[4]I2		;I/O Status Block.


	PROC

AAA_BEGIN_UTILITY,

	XCALL FLAGS (0001000000)

	OPEN (1,O,'SYS$OUTPUT:')

ABA_OBTAIN_PID,

	DISPLAY (1,<ERASE:1>)
	DISPLAY (1,"STOPRO - Utility to Force Image Exit"<POS:(1,1),VIDEO:2>)
	DISPLAY (1,"Enter Process ID: "<POS:(3,1)>)
	READS (1,PID<POS:(3,19),EDIT:"YYYYYYYY">)

	STATUS = %OTS$CVT_TZ_L(%DESCR(PID),%REF(INT_PID),
&	%VAL(INT_PID_Length),%VAL(1))

	IF (.NOT.%SUCCESS(STATUS)) XCALL LIB$STOP (%VAL(STATUS))

	CALL BAA_OBTAIN_PID_INFO

	PROC_ID = %HEX(SEARCH_PROCESS_ID)
	PROC_NAME = SEARCH_PROC_NAME
	USER_NAME = SEARCH_USER_NAME
	TERM_NAME = SEARCH_TERM_NAME
	NODE_NAME = SEARCH_NODE_NAME
	IMAGE_NAME = SEARCH_IMAGE_NAME

	;Display information we just obtained and ask them
	;if they are sure they want to force this image to exit.
	DISPLAY (1,<POS:(3,1),ERASE:2>)
	DISPLAY (1,"Process ID"<POS:(4,1)>)
	DISPLAY (1,PROC_ID<POS:(4,21)>)

	DISPLAY (1,"User Name"<POS:(7,1)>)
	DISPLAY (1,USER_NAME<POS:(7,21)>)
	DISPLAY (1,"Node Name"<POS:(7,41)>)
	DISPLAY (1,NODE_NAME<POS:(7,61)>)

	DISPLAY (1,"Process Name"<POS:(10,1)>)
	DISPLAY (1,PROC_NAME<POS:(10,21)>)
	DISPLAY (1,"Terminal Name"<POS:(10,41)>)
	DISPLAY (1,TERM_NAME<POS:(10,61)>)

	DISPLAY (1,"Image Name"<POS:(13,1)>)
	DISPLAY (1,IMAGE_NAME<POS:(13,21)>)

	.page
ABA_100_ARE_YOU_SURE,

	DISPLAY (1,"Are you sure you want to force this image to exit (Y/N): "
&	<POS:(19,1)>)
	READS (1,RESPONSE<POS:(19,59),EDIT:"A">)

	IF (RESPONSE .EQ. 'N') GOTO ABA_OBTAIN_PID
	IF (RESPONSE .NE. 'Y') GOTO ABA_100_ARE_YOU_SURE

ACA_STOP_PROCESS,

	STATUS = %SYS$FORCEX (%REF(INT_PID),,%VAL(STP_SUCCESS))
	IF (.NOT.%SUCCESS(STATUS)) XCALL LIB$STOP (%VAL(STATUS))
	STATUS = %LIB$SIGNAL (%VAL(STP_SUCCESS),%VAL(1),IMAGE_NAME)

AZA_EXIT_UTILITY,
	STOP
	.page
BAA_OBTAIN_PID_INFO,

	;Obtain Process info for this PID.

	Item_List[1].Buff_Length = %SIZE(SEARCH_PROCESS_ID)
	Item_List[1].Item_Code = JPI$_PID
	Item_List[1].Buffer_Addr = %ADDR(SEARCH_PROCESS_ID)
	Item_List[1].Return_Length = Zero

	Item_List[2].Buff_Length = %SIZE(SEARCH_PROC_NAME)
	Item_List[2].Item_Code = JPI$_PRCNAM
	Item_List[2].Buffer_Addr = %ADDR(SEARCH_PROC_NAME)
	Item_List[2].Return_Length = Zero

	Item_List[3].Buff_Length = %SIZE(SEARCH_USER_NAME)
	Item_List[3].Item_Code = JPI$_USERNAME
	Item_List[3].Buffer_Addr = %ADDR(SEARCH_USER_NAME)
	Item_List[3].Return_Length = Zero

	Item_List[4].Buff_Length = %SIZE(SEARCH_TERM_NAME)
	Item_List[4].Item_Code = JPI$_TERMINAL
	Item_List[4].Buffer_Addr = %ADDR(SEARCH_TERM_NAME)
	Item_List[4].Return_Length = Zero

	Item_List[5].Buff_Length = %SIZE(SEARCH_IMAGE_NAME)
	Item_List[5].Item_Code = JPI$_IMAGNAME
	Item_List[5].Buffer_Addr = %ADDR(SEARCH_IMAGE_NAME)
	Item_List[5].Return_Length = Zero

	End_Of_List = Zero

	STAT = %SYS$GETJPIW(,%REF(INT_PID),,%REF(Item_List),%Ref(IOSB),,)
	IF (.NOT.%SUCCESS(STAT)) XCALL LIB$STOP (%VAL(STAT))

BAA_010_CLEAR_ITEM_LIST,

	CLEAR LOOP
	FOR LOOP FROM 1 THRU 5
	BEGIN
		CLEAR Item_List[Loop].Buff_Length
		CLEAR Item_List[Loop].Item_Code
		CLEAR Item_List[Loop].Buffer_Addr
		CLEAR Item_List[Loop].Return_Length
	END

	.page
BAA_020_CHECK_NODE_NAME,

	;Obtain Node Name for Cluster Enviroment.
	Item_List[1].Buff_Length = %SIZE(SEARCH_NODE_NAME)
	Item_List[1].Item_Code = SYI$_NODENAME
	Item_List[1].Buffer_Addr = %ADDR(SEARCH_NODE_NAME)
	Item_List[1].Return_Length = Zero

	End_Of_List = Zero

	STAT = %SYS$GETSYIW (,,,%REF(Item_List),%Ref(IOSB),,)
	IF (.NOT.%SUCCESS(STAT)) XCALL LIB$STOP (%VAL(STAT))

BAA_EXIT,
	RETURN