PROGRAM FINDJOB

*
*	Input:  DCL Symbol "JOBNAME"
*
*	Output:  DCL Symbol "ORDINAL"
*
*	Checks all input queues to see if job whose name is in the DCL
*	Symbol JOBNAME exists.  If it does, DCL Symbol ORDINAL is set
*	To the (string) value of its ordinal number.  If it does not,
*	ORDINAL is set to the null string.
*
*	This program is used by SUBMIT_IF.COM.
*
*
*	Alan L. Zirkle     Naval Surface Weapons Center
*			   Code K53
*	(703) 663-7752     Dahlgren, Virginia  22448
*

	IMPLICIT INTEGER (A-Z)

	CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32

	INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19)

	COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN,
	1		 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER,
	2		 JOB_STATUS,JOB_UIC,DQ,DJ,IN

	CHARACTER PARAM*32

	COMMON /PARAM_/ PARAM,PA_LEN

	INTEGER*2 IOSB(4)

	DATA STAT / 1 /

	CALL INITIALIZE

    	DO WHILE (STAT)

	    STAT = SYS$GETQUIW(,%VAL(DQ),,QUEUE_ITEM_LIST,IOSB,,)

	    IF (.NOT.STAT) CALL LIB$STOP(%VAL(STAT))

	    STAT = IOSB(1)

	    IF (STAT) THEN

		STAT2 = 1

		DO WHILE (STAT2)

		    STAT2 = SYS$GETQUIW(,%VAL(DJ),,JOB_ITEM_LIST,IOSB,,)

		    IF (.NOT.STAT2) CALL LIB$STOP(%VAL(STAT2))

		    STAT2 = IOSB(1)

		    IF (STAT2 .AND. .NOT. BTEST(JOB_STATUS,IN)) THEN

			CALL CHECK_JOB

		    ENDIF

    	        ENDDO

	    ENDIF

    	ENDDO

	PA_LEN = 0

	STATUS = LIB$SET_SYMBOL('ORDINAL',PARAM(1:PA_LEN))

	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

	END
	SUBROUTINE CHECK_JOB

	IMPLICIT INTEGER (A-Z)

	CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32

	INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19)

	COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN,
	1		 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER,
	2		 JOB_STATUS,JOB_UIC,DQ,DJ,IN

	CHARACTER PARAM*32

	COMMON /PARAM_/ PARAM,PA_LEN

	CHARACTER USERNAME*12
	INTEGER*4 UIC
	LOGICAL*1 GROUP,OPER,WORLD

	COMMON /USER_/ USERNAME,UIC,GROUP,OPER,WORLD

	IF (PARAM(1:PA_LEN).NE.JOB_NAME(1:JN_LEN)) RETURN

*	Check privileges.

	IF (SUBMITTER(1:SU_LEN).NE.USERNAME) THEN

	    IF (PARAM_CODE.EQ.0) RETURN

	    IF (.NOT. (OPER .OR. WORLD)) THEN

		IF (.NOT.GROUP) RETURN

		IF (IAND(UIC,'FFFF0000'X).NE.
	1			       IAND(JOB_UIC,'FFFF0000'X)) RETURN

	    ENDIF

	ENDIF

	STATUS = SYS$FAO('!SL',PA_LEN,PARAM,%VAL(ENTRY_NUMBER))

	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

	STATUS = LIB$SET_SYMBOL('ORDINAL',PARAM(1:PA_LEN))

	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

	CALL EXIT

	END
	SUBROUTINE INITIALIZE

	IMPLICIT INTEGER (A-Z)

	CHARACTER SUBMITTER*12,QUEUE_NAME*32,JOB_NAME*32

	INTEGER*4 QUEUE_ITEM_LIST(10),JOB_ITEM_LIST(19)

	COMMON /GETQUI_/ QUEUE_ITEM_LIST,JOB_ITEM_LIST,SUBMITTER,SU_LEN,
	1		 QUEUE_NAME,QN_LEN,JOB_NAME,JN_LEN,ENTRY_NUMBER,
	2		 JOB_STATUS,JOB_UIC,DQ,DJ,IN

	CHARACTER PARAM*32

	COMMON /PARAM_/ PARAM,PA_LEN

	INTEGER*2 IOSB(4)

	CHARACTER SEARCH_NAME*1

    	DATA SEARCH_NAME,SN_LEN / '*' , 1 /

    	INCLUDE '($QUIDEF)/NOLIST'

	STATUS = LIB$GET_SYMBOL('JOBNAME',PARAM,PA_LEN)

	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))

	CALL GET_USER_INFO

	SEARCH_FLAGS = QUI$M_SEARCH_WILDCARD +
	1		      QUI$M_SEARCH_ALL_JOBS + QUI$M_SEARCH_BATCH

	CALL ITEM_LIST(QUEUE_ITEM_LIST,QUI$_SEARCH_FLAGS,SEARCH_FLAGS,
	1		QUI$_SEARCH_NAME,SEARCH_NAME,SN_LEN,
	2		QUI$_QUEUE_NAME,QUEUE_NAME,QN_LEN)

	CALL ITEM_LIST(JOB_ITEM_LIST,QUI$_SEARCH_FLAGS,SEARCH_FLAGS,
	1		QUI$_ENTRY_NUMBER,ENTRY_NUMBER,
	2		QUI$_USERNAME,SUBMITTER,SU_LEN,
	3		QUI$_JOB_NAME,JOB_NAME,JN_LEN,
	4		QUI$_JOB_STATUS,JOB_STATUS,
	5		QUI$_UIC,JOB_UIC)

	STATUS = SYS$GETQUIW(,%VAL(QUI$_CANCEL_OPERATION),,,IOSB,,)

	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))
	IF (.NOT.IOSB(1)) CALL LIB$STOP(%VAL(IOSB(1)))

	DQ = QUI$_DISPLAY_QUEUE		! We do these so we
	DJ = QUI$_DISPLAY_JOB		!  don't have to call
	IN = QUI$M_JOB_INACCESSIBLE	!   $QUIDEF elsewhere

	END
	SUBROUTINE GET_USER_INFO

	IMPLICIT INTEGER (A-Z)

	CHARACTER USERNAME*12
	INTEGER*4 UIC
	LOGICAL*1 GROUP,OPER,WORLD

	COMMON /USER_/ USERNAME,UIC,GROUP,OPER,WORLD

	INTEGER*4 PROC_PID,PROC_STAT,PROC_UIC
	CHARACTER*16 PROC_NAME
	CHARACTER*8  TERM_NAME
	CHARACTER*12 USER_NAME
	INTEGER*2 PNLEN,TNLEN,UNLEN

	COMMON /USER_DATA_/ PROC_PID, PROC_STAT,PROC_UIC,
	1		    PROC_NAME,TERM_NAME,USER_NAME,
	2		    PNLEN,    TNLEN,    UNLEN

	OPER  = USER_HAS_PRIV('OPER')

	WORLD = USER_HAS_PRIV('WORLD')

	GROUP = USER_HAS_PRIV('GROUP')

	USERNAME = USER_NAME(1:UNLEN)

	UIC = PROC_UIC

	END