c-----------------------------------------------------------------------
c
c	Strip Daily Appointment subroutine (DTC Purge command)
c
c	part of GLENN EVERHART'S MODS TO DTC program
c
c	Input: command line - 72 bytes, format:
c
c		P [mmddyy]
c		     or
c		U [mmddyy] [hh:mm[>hh:mm]]
c		     or
c		X [mmddyy] [hh:mm[>hh:mm]] [mmddyy] [hh:mm[>hh:mm]]
c
c	Output:
c		Reads dtc.dat, and builds new dtc.dat, in the process
c	strips old appointments (before date) from file (P),
c	deletes appointments at specified time and date (U),
c	or re-schedules (eXchanges) appointments from d1*t1 to d2*t2
c
c-----------------------------------------------------------------------
c

	SUBROUTINE strip		! (line)

c
c	Declarations:
c
	include 'comdtc.inc/nolist'
	include 'apptdtc.inc/nolist'
c
	parameter idspp = 1,	!	Function constants: Purge
	1	  idspu = 2,	!	.. Unschedule
	2	  idspx = 3	!	.. eXchange
c
c	byte line(1)		!	input line
	byte temp(2), ll,	!	temporary string converting array
	1 ln1, ap1

	integer eofflg, prveof,	!	For RDAPPT 'do while' loop
	1	firstflg
	integer	id, idx		!	Julian Day
	integer im, imx		!	Julian Month
	integer iye, iyx	!	Julian Year
	integer it1, it2, itx1, itx2	! time values 80 (8 AM) => 173 (5:30 PM)
c
	logical first		!	For X decode
	equivalence (line, ln1), (appoin, ap1)
c
	include 'stmtfunc.for/nolist'	! Get standard statement functions

c Parse input line:
c	Was there a P on the front?  If so, trim it off:
c

	isavinc = incmod		! Save for increment in DATCVT

	first = .true.			! Set it regardless of path

	If ( ln1 .eq. 'P' ) then

	    idisp = idspp		! Function to perform

	else

	    if (ln1 .eq. 'U') then
		idisp = idspu
	    else if (ln1 .eq. 'X') then
		idisp = idspx
	    else
		go to 999	! Error, can't decode it
	    end if

	    it1 = 80			! Set comparison values
	    it2 = 174
	    itx1 = it1
	    itx2 = it2

	End If

	call shrink (1, ifnb, lnb)

	if (ifnb .eq. 0) then
	    if (idisp .eq. idspp) then
		call dtcidate(im,id,iye)	! set to today's date
	    else
		go to 999		! Not enough info for U or X
	    end if
	else
c
c		If the date was specified in command line then
c		set id, im and iye to the right values:
c
 10	    call dtcdatcvt(3)			! (line)

	    if (first) then		! Note we decode into
		im = idmo		! second set of values,
		id = iddy		! then copy into first set
		iye = ibigyr		! first (or only) time around
	    end if			! (unlike Schlitz, we can go around twice)

	    if (idisp .ne. idspp) then	! other than purge
		itx2 = 173		! Set default for '*' or <null>
		call dtctimcvt(itx1, itx2)
		itx2 = itx2 + 1		! Add (10 mins) to allow semi-open interval
		if (first) then
		    it1 = itx1
		    it2 = itx2
		    if (idisp .eq. idspx) then
			if (ln1 .eq. 0) go to 999	! Error if nothing left
			first = .false.
			go to 10		! Re-cycle code
		    end if			! Done unless X
		end if
	    else				! P, guarantee no redisplay
		ln1 = "0			! Zap the line
	    end if				! Done parse for U, X
	end if					! Done date/time parse

	ixhash = ihymd(iye, im, id)		! Calc hash for day of interest

c ***	type 950, ixhash
c *** 950	format(2z9.8)

	if (idisp .eq. idspp)
	1 then					! Set request date for RDAPPT
	    irqhash(1) = ixhash			! Delete before
	  else
	    irqhash(1) = 0			! Look at everybody
	end if

	irqhash(2) = '7FFFFFFF'X		! 'Til the end of time

	firstflg = 0				! Zero until file opened for write

	prveof = 0
	eofflg = -1

	do while (prveof .ge. 0)

	    call dtcrdappt(eofflg, 1)		! Look at control entries

	    if (eofflg .gt. 0)
	1     then
		eofflg = 0			! Don't open it on return
		go to 190			! but re-write it as is

	    else if (eofflg .eq. 0)		! Test it now
	1     then

c ***	type 950, irchash

		iht = min0(max0(iht, 80), 173)	! Insure a kosher time value

		go to (110, 120, 130) idisp	! Dispatch on numeric value

 120		if ((irchash .eq. ixhash) .and.
	1	    ((iht .ge. it1) .and. (iht .le. it2)))
	2	    go to 100		! Criteria for Unscheduling (deleting)
		go to 190		! Do re-write

 130		if ((irchash .eq. ixhash) .and.
	1	    ((iht .ge. it1) .and. (iht .le. it2)))
	2	  then

		    iht = itx1 + (iht - it1)	! Get updated time
		    if (mod(iht, 10) .eq. 6) iht = iht + 4 ! go to next hour

		    if (iht .gt. itx2) go to 100	! Duration was shortened

		    ihy = ibigyr		! Change dates
		    ihm = idmo
		    ihd = iddy

		end if				! Usually re-write
c
 110		continue			! Purge, re-write

 190		if (firstflg .eq. 0)		! Can't open output till
	1	  then				! we have input!

		    close(2)
		    open(unit=2, file=FNAME, status='NEW',
	1		form='FORMATTED',
	1		carriagecontrol='LIST', err=999)

		    firstflg = 1		! Output now open

		end if

		write (2, 201) ihy, ihm, ihd, iht,
	1		apptstr(1:min0(max0(iaptln, 1), iaptlim))
c ***	1	  (appoin(k), k=1, min0(max0(iaptln, 1), iaptlim))
 201		format(i4.4, 2i2.2, i3.3, x, a) ! New format, 19850806113

	    end if			! eofflg

 100	    prveof = eofflg		! Set loop condition

	end do				! while

	if (firstflg .eq. 0)		! Purged everything?
	1 then				! create empty file

	    close(2)
	    open(unit=2, file=FNAME, status='NEW',
	1	form='FORMATTED',
	1	carriagecontrol='LIST', err=999)

	    firstflg = 1		! Output now open

	end if

	close(2)			! Done with new file

	return

 999	write (iterm, 990)		! Error on decode, write nastygram
 990	format('+Syntax or file-open (write) error.', $)
	ln1 = "0			! Inhibit rescan
c
	end