$STORAGE: 2
$NOFLOATCALLS
c-----------------------------------------------------------------------
c
c	Month-at-a-glance subroutine
c
c	part of Mitch Wyle's DTC program
c
c	Input: 
c		line 	- 	72 character string;  Format: M [dd[19[yy]]]
c
c	Output:
c		display screen (see below)
c
c-----------------------------------------------------------------------
c

	SUBROUTINE month(line)

c
c	Declarations:
c

	character line(1)		
c 	input line
	CHARACTER*2 TEMP2
	character temp(2)
	EQUIVALENCE(TEMP(1),TEMP2)
C	
c 	temporary string converting array
	character esc		
c 	escape character
	integer	id		
c 	Julian Day
	integer im		
c 	Julian Month
	integer iy		
c 	Julian Year
	character monthn(9)		
c 	string month name
	character out(79)		
c 	The output string and * array
	character appoin(60)		
	CHARACTER*20 APPOI6
	EQUIVALENCE(APPOIN(1),APPOI6)
c 	Appointment string
        character rchr
	integer rdspfg          
c   flag to reverse sense of display of time
	integer ctlfg           
c   misc control flags here
	INTEGER IDYR,IDMO,IDDY
	COMMON/DEFDAT/IDYR,IDMO,IDDY
	common/ctls/rdspfg,ctlfg
	character fname(60)
	CHARACTER*60 FNAM60
	EQUIVALENCE(FNAME(1),FNAM60)
	integer fnsz
	common/fn/fnsz,fname

c
c	Initialize:
c

	iterm = 0		
c 	Output terminal unit number
	esc = 27		
c 	Escape character
	IM=IDMO
	ID=IDDY
	IY=IDYR
C	call idate(im,id,iy)	
c 	initialize to today's date


c
c		Trim off the M from command line:
c

	Do 1 i=1,70
	    line(i) = line(i+2)
1	Continue
	CALL DATMUN(LINE)
c
c		If the month was specified in command line then
c		set im and iy to the right values:
c

	If ( ( line(1) .ge. '0' ) .and. ( line(2) .le. '9' ) ) then
	    temp(1) = line(1)
	    temp(2) = line(2)
	read(temp2,2)im
c	    decode ( 2 , 2 , temp ) im
	IDMO=IM
	End If
	If ( ( line(3) .ge. '0' ) .and. ( line(4) .le. '9' ) ) then
	    temp(1) = line(3)
	    temp(2) = line(4)
	read(temp2,2)iy
c	    decode ( 2 , 2 , temp ) iy
	IDYR=IY
	End If
2	Format(i2)

c
c		Clear the screen, move the cursor to the top part,
c

	write(iterm,6) esc,'<',esc,'[','2','J',esc,'[','0','1',';','0',
     1  '1','H'

c
c		Now start building the output string: (out)
c

	Do 3 i=1,79
	    out(i) = ' '
3	Continue

	If ( im .eq. 1 ) then
	    nm = 12
	    ny = iy - 1
	Else
	    nm = im - 1
	    ny = iy
	End If
C PRINT PREVIOUS MONTH
	call gaby(nm,monthn)

	j = 0
	Do 4 i=1,17,2
	    j = j + 1
	    out(i) = monthn(j)
4	Continue

	out(37) = '1'
	out(39) = '9'
	write(temp2,2)iy
c	encode( 2 , 2 , temp ) iy
	out(41) = temp(1)
	out(43) = temp(2)

	lm = im + 1
	If ( lm .gt. 12 ) then
	    lm = 1
	    ly = iy + 1
	End If
C PRINT NEXT MONTH CALENDAR AT TOP
	call gaby(lm,monthn)

	Do 5 i=1,9
	    j = (i*2)-1
	    out(j+62) = monthn(i)
5	Continue
C WRITE OUT HDR FOR LAST, NEXT MONTH, THEN DAYS
	write(iterm,6) out
6	format(1x,79a1,\)
	write(iterm,7)
7	format(1x,'Su Mo Tu We Th Fr Sa',40X,'Su Mo Tu We Th Fr Sa')

c
c	Now display last month, header for this month, and next month:
c

	If ( im .eq. 1 ) then
	    lm = 12
	    ly = iy - 1
	Else
	    lm = im - 1
	    ly = iy
	End If

	If ( im .eq. 12) then
	    nm = 1
	    ny = iy + 1
	Else
	    nm = im + 1
	    ny = iy
	End If

	call dany(ib,il,lm,ly)
	call mischy(ib,il,0,0,0,0)
	call dany(ib,il,nm,ny)
C CHANGE ,69, NEXT TO ,59, ...
	call mischy(ib,il,59,0,0,0)

c
c		dislpay big banner header name of this month:
c

	call dtcat(37,7)
	call gaby(im,monthn)
	    write(iterm,8) monthn
8	    format(1X,9a1)
9	Continue

c
c	Now print the week day headers for this month, and the days
c	for this month:
c

C	call dtcat(1,9)
	call dtcat(1,8)
	write(iterm,10)
10	format(/,8x,'SUNDAY',3X,'MONDAY',3X,'TUESDAY',2X,'WEDNESDAY',2X,
     1  'THURSDAY',3X,'FRIDAY',5X,'SATURDAY',/)

	call dany(ib,il,im,iy)
	call mischy(ib,il,1,7,8,1)

c
c		Now for files I/O to put *'s on days with appointments:
c

	Do 110 i=1,31		
c  set the out array to all blanks:
	 if(rdspfg.eq.0)then
	    out(i) = ' '
	 else
	    out(i)='*'
	 end if
	if(rdspfg.eq.0)then
		rchr='*'
	else
		rchr=' '
	end if
110	continue
C CLOSE UNIT 1, JUST IN CASE IT WAS OPEN...
	CLOSE(1)
	Open (1,file=FNAM60,status='OLD',form='FORMATTED')
	iunit=1
111	Continue    
c  ===================================================
	    Read(IUNIT,115,end=122) ihy,ihm,ihd,iht,(appoin(k),k=1,60)	
c 
115	    format(3i2,i3,60a1)						
c 
c single indirection if year = 99
c this permits use of multiple data files for scheduling purposes
c maintained by an editor. Note the format is
c999999999filename=
c where
c filename may be absolutely any file spec whatever...
	if(IUNIT.EQ.1.AND.ihy.eq.99)then
	iunit=2
c null terminate the filename somewhere
c lines with 99 in 1st 2 cols are filenames only...
c use = as delimiter of filename
	appoin(60)=32
	kkk=0
	do 1068 ii=1,59
	if(appoin(ii).le.32.or.appoin(ii).eq.'=')kkk=1
	if(kkk.gt.0)appoin(ii)=32
c	if(appoin(ii).eq.'=')appoin(ii)=0
1068	continue
	Open(iunit,file=appoi6,status='old',form='formatted')
	goto 111
	end if
									
c 
	    If (( ihm .eq. im ) .and. ( ihy .eq. iy )) out(ihd) = rchr  
c 
	    goto 111							
c 
122	Continue    
c ====================================================
	if(iunit.ne.1)then
1066	close(2)
	iunit=1
	goto 111
	end if

	call idate(irm,ird,iry)				
c  Real month,day,year
	If ((irm.eq.im).and.(iry.eq.iy)) out(ird)='#'	
c  put # character on.

	close(1)
	iy = 12
C WAS IY=13
	ip = ib - 1
	
	Do 1115 i=1,il

	    ip = ip + 1			
c 	increment day number
	    If ( ip .gt. 7 ) then	
c 	is it Sunday again?
		ip = 1			
c 	reset day to Sunday.
		iy = iy + 2 		
c 	move down one line
	    End If
	    ix = 10 * ip - 2
	    call dtcat(ix,iy)		
c 	position cursor
	    write(iterm,231) out(i)	
c 	write * to screen
231	    format(1X,a1)

1115	Continue
	
	call dtcat(1,23)

	return
	end