.TITLE	SETPEN
	.GLOBL	.DA,SETPEN,BEGIN
SETPEN	XX
	JMS*	.DA
	JMP	.+5
ITAG	.DSA	0
LPEN	.DSA	0
IX	.DSA	0
IY	.DSA	0
	CAL
	16
	700701		/SKIP ON LTPEN
	PENSEE
	DBK
	JMP*	SETPEN
HEAD	XX
HEAD2	XX
PENSEE	DAC	SAVEAC#
	LAC*	(0
	DAC	SETPEN
	700512		/READ DAC
	CMA
	TAD	(2
	DAC	MDACAD#
	LAC*	BEGIN
	DAC	HEAD
LUP	LAC	HEAD
	TAD	MDACAD
	SMA
	JMP	FOUND
	LAC	HEAD
	DAC	HEAD2
	LAC*	HEAD2
	AND	(200000
	SZA
	JMP	FOUND
	LAC*	HEAD
	AND	(177777
	TAD	HEAD
	DAC	HEAD
	JMP	LUP
/
/
/
FOUND	LAC	HEAD2
	TAD	(1
	DAC	TAGAD#
	LAC*	TAGAD
	AND	(377777
	DAC*	ITAG
	LAW	-1
	DAC*	LPEN
	700712
	DAC	XY#
	AND	(777
	RCL
	DAC*	IY
	LAC	XY
	LRSS 10
	AND	(1777
	DAC*	IX
	LAC	SAVEAC
	700504
	ION
	DBR
	XCT	.+1
	JMP*	SETPEN
	.END