PROGRAM REDQ

C	THIS PROGRAM WILL READ MESSAGES WRITTEN TO THE QUEUE AND ACK
C	THE MESSAGE OR PUT IT BACK ON THE QUEUE (RNA FUNCTION).

	PARAMETER	ZEFN = 1	! QIO TO QUEUE SYNC EVENT FLAG
	PARAMETER	TEFN = 2	! TASK WAKEUP EVENT FLAG
	PARAMETER	ZLUN = 1	! QUEUE LUN
	PARAMETER	MSGLEN = 4100	! MAX MESSAGE SIZE (READ FROM QUEUE)
	PARAMETER	IEEOF = -10	! NO MESSAGES IN SUBQUEUE ERROR
	PARAMETER	IEPNT = -71	! NO MESSAGE NEEDS TO BE ACK
	PARAMETER	DELCNT = 20	! WHEN THIS MANY MSGS HAVE BEEN READ,
					!   TASK WILL DELAY TO SIMULATE A
					!   NODE BEING DOWN
	
	INTEGER*2	STATUS		! QUEUE FUNCTION STATUS
	BYTE		BSTAT(2)	! STATUS AS 2 BYTES
	EQUIVALENCE	(STATUS,BSTAT)	
	CHARACTER*16	MSGID		! MESSAGE ID SUBQUEUE TO READ MSGS
					!   FROM
	BYTE		MSGBUF(MSGLEN)	! BUFFER MESSAGE READ INTO
	INTEGER*2	RECSIZ		! SIZE OF MESSAGE READ FROM QUEUE
	INTEGER*2	RNA		! READ NOT ACKNOWLEDGE ID
	INTEGER*2	CNT		! NUMBER OF MESSAGES READ SINCE LAST 
					!   DELAY

	INTEGER*2	INITQ,ATCHQ,READQ,ACKQ,RNAQ	! FUNCTION RETURN STATUS

	DATA	MSGID	/'TEST30'/	! MESSAGE ID NAME

	STATUS = INITQ(ZLUN)		     ! SETUP QUEUE EXIT HANDLER
	IF (STATUS.NE.1) THEN
		TYPE *,' '
		TYPE *,' BAD QUEUE STATUS ON INIT'
		TYPE *,' DIRECTIVE STATUS: ',BSTAT(1)
		TYPE *,' I/O STATUS: ',BSTAT(2)
		GOTO 9000
	END IF			

	STATUS = ATCHQ(ZLUN,ZEFN,MSGID,TEFN)   ! ATTACH TO MESSAGE ID SUBQUEUE
	IF (STATUS.NE."401) THEN
		TYPE *,' '
		TYPE *,' BAD QUEUE STATUS ON ATTACH'
		TYPE *,' DIRECTIVE STATUS: ',BSTAT(1)
		TYPE *,' I/O STATUS: ',BSTAT(2)
		GOTO 9000
	END IF

	CNT = 0

25	CALL CLREF(TEFN)			! CLEAR WAKEUP EVENT FLAG 
		
27	STATUS = READQ(ZLUN,ZEFN,MSGID,MSGBUF,
	1	       MSGLEN,RECSIZ,RNA)	! READ MESSAGE FROM QUEUE
	IF (BSTAT(2).EQ.IEEOF) GOTO 1000	! NOTHING TO READ

	IF (STATUS.NE."401) THEN
		TYPE *,' '
		TYPE *,' BAD QUEUE STATUS ON READ'
		TYPE *,' DIRECTIVE STATUS: ',BSTAT(1)
		TYPE *,' I/O STATUS: ',BSTAT(2)
		GOTO 9000
	END IF

	CNT = CNT + 1

	IF (CNT.EQ.10) THEN		! PUT EVERY TENTH MESSAGE READ BACK
					!   ON QUEUE
	    STATUS = RNAQ(ZLUN,ZEFN,MSGID)	
	    IF (STATUS.NE."401) THEN
		TYPE *,' '
		TYPE *,' BAD QUEUE STATUS ON RNA'
		TYPE *,' DIRECTIVE STATUS: ',BSTAT(1)
		TYPE *,' I/O STATUS: ',BSTAT(2)
		GOTO 9000
	    END IF
	ELSE				! ACK MESSAGE
	    STATUS = ACKQ(ZLUN,ZEFN,MSGID,RNA)	
	    IF (BSTAT(2).EQ.IEPNT) GOTO 27	! NO MESSAGE TO ACK
	    IF (STATUS.NE."401) THEN
		TYPE *,' '
		TYPE *,' BAD QUEUE STATUS ON ACK'
		TYPE *,' DIRECTIVE STATUS: ',BSTAT(1)
		TYPE *,' I/O STATUS: ',BSTAT(2)
		GOTO 9000
	    END IF
	END IF
		
	IF (CNT.GE.DELCNT) THEN
		CNT = 0
		CALL WAIT(20,2)			! WAIT 20 SECONDS TO
						!   SIMULATE DELAY
	END IF

	GOTO 27					! TRY TO READ ANOTHER
						!   MESSAGE

1000	CALL WAITFR(TEFN)			! WAIT FOR ANOTHER MESSAGE
	GOTO 25

9000	CALL DISCQ(ZLUN)			! DISCONNECT
	CALL EXIT

	END