SUBROUTINE EXT(IEXT)
	DIMENSION IDATE(2),MONTH(13),NUMBER(13)
	DATA MONTH/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG',
	1'SEP','OCT','NOV','DEC',0/
	DATA NUMBER/'.01','.02','.03','.04','.05','.06','.07','.08'
	1 ,'.09','.10','.11','.12',0/
C				MAKE A THREE LETTER ALPHA EXTENSION
C				OUT OF THE DATE (2-DEC-70 GOES TO .121)
	CALL DATE(IDATE)

C				WATCH OUT FOR ONE DIGIT DAY OF MONTH
	IF((IDATE(1).AND."774000 000000).EQ."200000 000000)
	1   IDATE(1) = IDATE(1).AND."3777 777777.OR."300000 000000
C				CONVERT THE DAY TO INTEGER
	IDAY = ISHIFT(IDATE(1),-21)
	IDAY = (IDAY-ISHIFT(ISHIFT(IDAY,-7),7))/2-"60
	1 + (ISHIFT(IDAY,-8)-"60)*10
C				CONVERT THE DAY TO WEEK
	IDAY = IDAY/7 + 1
C				LEFT ADJUST-BLANK FILL THE MONTH
	NONTH = ISHIFT(IDATE(1),21).OR.ISHIFT(ISHIFT(IDATE(2),-28),14)
	1 .OR. "20100
C				FIND THE MONTH NUMBER

	DO 10 I=1,13
	IF(NONTH.EQ.MONTH(I)) GO TO 15
10	CONTINUE
	STOP

C				SET EXT TO THE CORRESPONDING MNEMONIC
C				AND OR IN THE WEEK NUMBER
15	CONTINUE
	IEXT = NUMBER(I) + ISHIFT(IDAY+"20,8)
	R E T U R N
	E N D