$STORAGE: 2
$NOFLOATCALLS
c DR:[333,106]OUTPT.FTN
c
c-----------------------------------------------------------------
c
c	Output subroutine for Mitch Wyle's (and Glenn Everhart's)
c
c		D esk   T op    C alendar   program
c
c	Inputs:
c		line - character array containing date range to output
c
c	Output:
c		DTC.OUT file, to be printed
c
c-----------------------------------------------------------------
c

c To the reader of this code:
c
c This routine does NOT perform to specifications.  The date
c range check is incomplete.
c
c
c This code is worse than a kludge; it is DIE code (Designed In Editor)
c The output spec was conceived and coded in the editor, and the algorithm
c to get the output stinks.
c The idea of using an output record a la COBOL is sound.  It is conceptually
c best to build up an array by calls to date functions and subroutines,
c HOWEVER, the coward arrays and repetitive loops are wasteful and unneccessary
c This routine needs a major re-write
c !!!!
c The output specification and format is fine (for my uses); If you do
c re-write this routine, here are some ideas:
c
c	o Include the file indirection to print several calendar files'
c	  appointments.
c
c	o build functions which call the subroutine dany; use these functions
c	  to make the out array for printing;
c	o eliminate the coward arrays; do fancy math in the code instead
c
c	o Create alternate outputs, such as
c	    - Year-At-A-Glance output
c	    - collumns or boxes on page with appointments AND blank areas
c	      which are free
c
c I apologize for this lousy code; I hope Glenn or somebody cleans it up again.
c

	SUBROUTINE OUTPT(line)


	character line(1)		
c 	input line
	character temp(2)		
	CHARACTER*2 TEMP2
	EQUIVALENCE(TEMP(1),TEMP2)
c 	temporary string converting array
	character appoin(60)		
c 	appointment string
	character work(60)           
c   scratch array for handling scheduling
	character esc		
c 	escape character
	integer	id,id2		
c 	Julian Day
	integer im,im2		
c 	Julian Month
	integer iye,iye2	
c 	Julian Year
	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)
	integer fnsz
	character*60 fnam60
	equivalence(fname(1),fnam60)
	common/fn/fnsz,fname
	LOGICAL  got1, got2	
c  flags to signal which date(s) passed in
	character out(80)		
c  output record for appointment file
	character monthn(9)
	INTEGER cowrd1(7,6)	
c  binary array for last month
	INTEGER cowrd2(7,6)	
c  binary array for this month
	INTEGER cowrd3(7,6)	
c  binary array for next month
				
c  maximum of 6 weeks in a month

	do 1 i=1,40		
c  trim off the 'O ' from begining
	    line(i) = line(i+2)
1	continue

	got1 = .false.
	got2 = .false.

	CALL DATMUN(LINE)	
c  if date(s) was(ere) specified in line, then
	Do 22 i=1,6		
c  extract it (them) from line:
	    If ( ( line(i) .gt. '9' ) .or. ( line(i) .lt. '0' ) ) goto 33
22	Continue
	got1 = .true.		
c  flag existence of 1st date
	temp(1) = line(1)	
c  Six numbers in a row, 
	temp(2) = line(2)	
c  decode into numeric date:
	read(temp2,2)im
c	decode ( 2 , 2 , temp ) im
	temp(1) = line(3)
	temp(2) = line(4)
	read(temp2,2)id
c	decode ( 2 , 2 , temp ) id
	temp(1) = line(5)
	temp(2) = line(6)
	read(temp2,2)iye
c	decode ( 2 , 2 , temp ) iye
2	Format(i2)

	Do 3 i=1,63		
c  Now discard the first date 
	    line(i) = line(i+7)	
c  part from line string:
3	continue
	got2 = .true.		
c  flag existence of second date
	CALL DATMUN(LINE)	
c  if 2nd date was specified in line, then
	Do 23 i=1,6		
c  extract it from line also:
	    If ( ( line(i) .gt. '9' ) .or. ( line(i) .lt. '0' ) ) goto 33
23	Continue
	temp(1) = line(1)	
c  Six numbers in a row, 
	temp(2) = line(2)	
c  so decode into numeric date:
	read(temp2,2)im2
c	decode ( 2 , 2 , temp ) im2
	temp(1) = line(3)
	temp(2) = line(4)
	read(temp2,2)id2
c	decode ( 2 , 2 , temp ) id2
	temp(1) = line(5)
	temp(2) = line(6)
	read(temp2,2)iye2
c	decode ( 2 , 2 , temp ) iye2

33	continue
	If (.not. got1) call idate(im,id,iye)	
c  default start date = today
	If (.not. got2) then			
c  default ending date
	    im2 = 12				
c  is dec 31, 1999
	    id2 = 31
	    iye2 = 99
	end if

	open (4,file='DTC.OUT',form='FORMATTED',status='NEW')
	call idate(idis1,idis2,idis3)
	write(4,38) idis1,idis2,idis3
38	format('1 DTC Rev 22-NOV-83    Appointments Summary',
     1		10x,' Print Date: ',2(i2,'/'),i2,/)

	Do 34 i=1,80		
c  start building the output line array
	    out(i) = ' '	
c  first fill it with blanks
34	Continue

	If ( im .eq. 1 ) then	
c  get previous month's month name string
	    nm = 12		
c  logic here is for year boundaries
	    ny = iy - 1
	Else
	    nm = im - 1
	    ny = iye
	End If
	call gaby(nm,monthn)	
c  got the string, now stick it in output
	j = 0			
c  spacing it every other letter
	Do 4 i=1,17,2
	    j = j + 1
	    out(i) = monthn(j)
4	Continue
	call gaby(im,monthn)	
c  now get this month's month name string
	j = 0			
c  and stick it into output string same way
	Do 5 i=1,17,2
	    j = j + 1
	    out(i+28) = monthn(j)
5	continue
	ly = iye
	lm = im + 1		
c  Get next month's month name string
	If ( lm .gt. 12 ) then	
c  and stick into output string
	    lm = 1
	    ly = iye + 1
	End If
	call gaby(lm,monthn)
	Do 61 i=1,9
	    j = (i*2)-1
	    out(j+55) = monthn(i)
61	Continue

	write(4,6) (out(i),i=1,79)	
c  WRITE MONTH NAME HEADERS
6	format(1x,79a1)

	write(4,69)
69	format(' Su Mo Tu We Th Fr Sa ',5x,' Su Mo Tu We Th Fr Sa ',
     1		5x,' Su Mo Tu We Th Fr Sa')

c	Now do the calendar logic to build the three months' numeric
c	calendar displays and load them into OUT one line at a time
c	Hmmmmmm.... how do we wanna do this?
c
c	I shall take the coward's way out:
c	we shall build three numeric arrays, one for each month 
c	three numeric arrays which contain the dates for last month,
c	this month, and next month in binary, then fill OUT with the
c	ascii rows from each, and print OUT....


c	lm contains next months month number
c	nm contains last months month number
c	im contains this months month number
c		send these guys into dany...
c	use dany and extract algorithm out of mischy to build these
c	three coward arrays

	call dany(ib,il,nm,ny)		
c  get day of week, days in month
					
c  for last month
	ip = ib - 1			
c  day of week pointer (collumn #)
	iy = 1				
c  row number index into array
	Do 7 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 + 1		
c  move down one line
	    End If
	    cowrd1(ip,iy) = i		
c  stick date into binary array
7	Continue

	call dany(ib,il,lm,ly)		
c  get day of week, days in month
					
c  for next month
	ip = ib - 1			
c  day of week pointer (collumn #)
	iy = 1				
c  row number index into array
	Do 8 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 + 1		
c  move down one line
	    End If
	    cowrd3(ip,iy) = i		
c  stick date into binary array
8	Continue
	call dany(ib,il,im,iye)		
c  get day of week, days in month
					
c  for this month
	ip = ib - 1			
c  day of week pointer (collumn #)
	iy = 1				
c  row number index into array
	Do 9 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 + 1		
c  move down one line
	    End If
	    cowrd2(ip,iy) = i		
c  stick date into binary array
9	Continue

c	Now we have finished building the coward arrays; just
c	stick data from them into OUT, one line at a time and print
c	OUT, and we are through with header section, so:

	Do 12 io=1,6

	    Do 10 i=1,79
		out(i) = 0
10	    continue

	    j = 1
	    Do 11 i=1,7
	write(temp2,2)cowrd1(i,io)
c	        encode(2,2,temp) cowrd1(i,io)
		out(j)= temp(1)
		out(j+1) = temp(2)
	write(temp2,2)cowrd2(i,io)
c		encode(2,2,temp) cowrd2(i,io)
	        out(j+27) = temp(1)
		out(j+28) = temp(2)
	write(temp2,2)cowrd3(i,io)
c		encode(2,2,temp),cowrd3(i,io)
		out(j+54) = temp(1)
		out(j+55) = temp(2)
		j = j + 3
11	    continue

		Do 118 ii=1,80				
c  if values are
		    if (out(ii).eq.0) out(ii) = ' '	
c  0, make em blanks
		    if ((out(ii).eq.'0').and.		
     1			(out(ii-1).lt.'1'))out(ii)=' '
c  unless we want 0's
118		continue

	    write(4,13) (out(i),i=1,79)
13	    FORMAT(1X,79a1)

12	continue

c	now read appointments	

	open (1,file=fnam60,form='FORMATTED',status='OLD')
C IBM PC MINI COMPILER DOESN'T HAVE ERR= ON OPENS.
	write(4,15)		
c  skip a line past last one on calendars
15	format(/)

21	continue			
c  now process appointments:
	    read(1,722,end=26) iyo,imo,ido,itim,(appoin(i),i=1,60)
722	    format(i2,i2,i2,i3,60a1)

c
c	Check to see if appointment is in range:
c	qqq stick range check code here ************** qqq ************
c
c	If .not.((imo.ge.ime).and.(imo.le.im2)) goto 21
c

	    write(4,723) imo,ido,iyo,itim,(appoin(i),i=1,60)
723	    format(1x,i2,'/',i2,'/',i2,2x,i3,'0',' - ',60a1)

		goto 21

26	continue

990	return
	end