c-----------------------------------------------------------------------
c
c	Month-at-a-glance subroutine
c
c	part of Mitch Wyle's DTC program
c
c	Input: 
c		line 	- 	72 byte string;  Format: M [dd[19[yy]]]
c
c	Output:
c		display screen (see below)
c
c-----------------------------------------------------------------------
c
	OPTIONS/NOI4

	SUBROUTINE month(line)

c
c	Declarations:
c
	CHARACTER*1 Cesc,Cnull,Cbell
	CHARACTER*4 Cbold, Cnorm

	byte line(1)		!	input line
	byte temp(2)		!	temporary string converting array
	byte esc		!	escape character
	byte monthn(9)		!	string month name
        byte rchr		!
	byte fname(60)		!
	byte appoin(60)		!	Appointment string
	Byte out(79)		!	The output string and * array
	integer	id		!	Julian Day
	integer im		!	Julian Month
	integer iy		!	Julian Year
	integer fnsz		!
	integer rdspfg          !  flag to reverse sense of display of time
	integer ctlfg           !  misc control flags here
	INTEGER IDYR,IDMO,IDDY
	COMMON/DEFDAT/IDYR,IDMO,IDDY
	common/fn/fnsz,fname
	common/ctls/rdspfg,ctlfg
	COMMON  /Constants/	Cesc,Cbell,Cnull,Cbold,Cnorm


c
c	Initialize:
c

	esc = "033		!	Escape character
	IM=IDMO
	ID=IDDY
	IY=IDYR
C	call idate(im,id,iy)	!	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)
	    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)
	    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(*,6) 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 
	call gaby(nm,monthn)		! PRINT PREVIOUS MONTH

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

	out(37) = '1'
	out(39) = '9'
	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 
	call gaby(lm,monthn)		! PRINT NEXT MONTH CALENDAR AT TOP

	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(*,6) out
6	format(x,79a1)
	write(*,7)
7	format(x,'Su Mo Tu We Th Fr Sa',T62,'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 idate(irm,ird,iry)				! Real month,day,year
	call dany(ib,il,lm,ly)
	Ibold=0						! If this month, bold
	If ((irm.eq.lm).and.(iry.eq.ly)) Ibold=Ird	! the day
	call mischy(ib,il,0,0,0,0,Ibold)
	call dany(ib,il,nm,ny)
	Ibold=0
	If ((irm.eq.nm).and.(iry.eq.ny)) Ibold=Ird	! the day
	call mischy(ib,il,60,0,0,0,Ibold)

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

	call dtcat(37,7)
	call gaby(im,monthn)
	    write(*,8) monthn
8	    format('+',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(*,10)
10	format(/,8x,'Sunday',3X,'Monday',3X,'Tuesday',2X,'Wednesday',2X,
     1  'Thursday',3X,'Friday',5X,'Saturday',/)

	call dany(ib,il,im,iy)
	Ibold=0						! If this month, bold
	If ((irm.eq.im).and.(iry.eq.iy)) Ibold=Ird	! the day
	call mischy(ib,il,1,7,8,1,Ibold)

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

	Do 110 i=1,31		! 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(1)		! CLOSE UNIT 1, JUST IN CASE IT WAS OPEN...
	Open (unit=1,file=FNAME,status='UNKNOWN',form='FORMATTED',
     -	      ERR=8050)
	iunit=1
111	Continue    ! ===================================================
	    Read(IUNIT,115,end=122) ihy,ihm,ihd,iht,(appoin(k),k=1,60)	!
115	    format(3i2,i3,60a1)						!
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(59)=0
	do 1068 ii=1,59
	if(appoin(ii).eq.'=')appoin(ii)=0
1068	continue
	Open(unit=iunit,file=appoin,status='old',form='formatted',
     1  err=1066)
	goto 111
	end if
									!
	    If (( ihm .eq. im ) .and. ( ihy .eq. iy )) out(ihd) = rchr  !
	    goto 111							!
122	Continue    !====================================================
	if(iunit.ne.1)then
1066	close(2)
	iunit=1
	goto 111
	end if

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

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

	    ip = ip + 1			!	increment day number
	    If ( ip .gt. 7 ) then	!	is it Sunday again?
		ip = 1			!	reset day to Sunday.
		iy = iy + 2 		!	move down one line
	    End If
	    ix = 10 * ip - 2
C	    Make the '*' bold
	    call dtcat(ix,iy)		!	position cursor
	    write(*,231) Cbold,out(i),Cnorm	!	write * to screen
231	    format('+',A,a1,A)

1115	Continue
	
	call dtcat(1,23)

	return
8050	WRITE(*,8060)Cnull,Cesc,(Fname(I),I=1,fnsz),Cesc,Cbell
8060	FORMAT(A,A,'[24;1HDTC -- Appointment file can not be created: ',
     -	       <Fnsz>A1,A,'[23;1H',A,$)
	GOTO 9999
	
9999	WRITE(*,9998)Cnull//Cesc//'[23;10H'
9998	FORMAT(A,$)
	RETURN

	end
