C	PROGRAM DATE.FT
C	---------------
C
C
C	PETER LEMKIN, GERSON GROSFELD AND MORT SCHULTZ
C	NATIONAL INSTITUTES OF HEALTH
C	BETHESDA, MD. 20014
C
C	JAN 5, 1978
C	OCT 30, 1976
C	REVISED NOV  3, 1975	G. GROSFELD
C	REVISED NOV 24, 1975	G. GROSFELD
C	REVISED JAN 2, 1976
C
C	PURPOSE
C	-------
C	DETERMINE IF THE 24 HOUR CLOCK IS PRESENT. IF SO,
C	USE IT TO COMPUTE THE OS/8 DATE AND RESET THE OS/8
C	DATE IF IT DOESN'T MATCH. ALSO PRINT THE TIME OF DAY
C	ON THE TERMINAL AND LINE PRINTER.
C
C
C
S	OPDEF DCAI 3400
S	OPDEF TADI 1400
S	OPDEF MQL 7421
S	OPDEF MQA 7501
S	OPDEF EXADR 6450
S	OPDEF EXIN 6333
C
	DIMENSION TABLE(12), NDAYS(12), BNAME(9)
C
C
C	[0.0] INITIALIZE
	KHH=0
	KHL=0
	KMH=0
	KML=0
	KSH=0
	KSL=0
	KLO=0
	KMID=0
	KHI=0
	NDATE=0
	KDATE=0
	KDAYS=0
	KLOCK=0
C
C*******NOTE: SET LEAPSW TO 1 WHEN IYEAR=1976
	IYEAR=1978
	LEAPSW=0
C
99	TABLE(1)='JAN'
	TABLE(2)='FEB'
	TABLE(3)='MAR'
	TABLE(4)='APR'
	TABLE(5)='MAY'
	TABLE(6)='JUN'
	TABLE(7)='JUL'
	TABLE(8)='AUG'
	TABLE(9)='SEP'
	TABLE(10)='OCT'
	TABLE(11)='NOV'
	TABLE(12)='DEC'
C
C
	NDAYS(1)=31
	NDAYS(2)=28 + LEAPSW
	NDAYS(3)=31
	NDAYS(4)=30
	NDAYS(5)=31
	NDAYS(6)=30
	NDAYS(7)=31
	NDAYS(8)=31
	NDAYS(9)=30
	NDAYS(10)=31
	NDAYS(11)=30
	NDAYS(12)=31
C
C
C
	BNAME(1)='CHIEF '
	BNAME(2)='PETE  '
	BNAME(3)='BRUCE '
	BNAME(4)='GERSON'
	BNAME(5)='MORT  '
	BNAME(6)='MARTA '
	BNAME(7)='JO    '
	BNAME(8)='TOM   '
	BNAME(9)='DICK  '
C
C
C
C	[0.1] GET OS/8 DATE WORD
S	6211		/CDF 10 (FIELD 1)
S	TADI (7666	/LOCATION OF DATE WORD
S	CPAGE 2
S	JMS 45	/RESTORE CURRENT FIELD
S	NOP
S	DCA \NDATE	/SAVE OS/8 DATE WORD
C
C
C
C	[1.0] IF CLOCK PRESENT THEN [2.0]; ELSE [1.1]
S	IAC		/SET ACTO 1
S	EXADR		/IF CLOCK PRESENT THE AC CLEARED (RTPP MACHINE)
S	SNA CLA	/SKIP IF NOT RIGHT MACHINE
S	JMP \200	/RIGHT MACHINE, LET'S GO TO WORK!
C
C
C	[1.1] IF OS/8 DATE NOT SET, PRINT "NONE" BEFORE EXITING.
S	TAD \NDATE	/GET OS/8 DATE WORD
S	SZA CLA		/SKIP IF NOT SET
S	JMP \400		/NO CLOCK, GO TO BIRTHDAYS
	WRITE(1,1111)
1111	FORMAT('NONE',/)
	CALL EXIT
C

C	[2.0] GET CLOCK DATA
200	KLOCK=1
S 	EXADR		/SET CHANNEL
S	EXIN		/READ DATA
S	DCA \KLO
C
S	CLA IAC		/SET NEXT CHANNEL
S	EXADR
S	EXIN		/GET DATA
S	DCA \KMID
C
S	TAD (2		/SET UP NEXT CHANNEL
S	EXADR
S	EXIN		/GET DATA
S	DCA \KHI
C
C
C	[2.2] UNPACK SECONDS, MINUTES, HOURS, AND DAY
S	TAD \KLO
S	AND (0017
S	DCA \KSL
C
S	TAD \KLO
S	RTR;RTR
S	AND (0017
S	DCA \KSH
C
S	TAD \KLO
S	RTL;RTL;RAL
S	AND (0017
S	DCA \KML
C
S	TAD \KMID
S	AND (0017
S	DCA \KMH
C
S	TAD \KMID
S	RTR;RTR
S	AND (0017
S	DCA \KHL
C
S	TAD \KMID
S	RTL;RTL;RAL
S	AND (0017
S	DCA \KHH
C
S	TAD \KHI
S	AND (0017
S	DCA \KLO
S	TAD \KHI
S	RTR;RTR
S	AND (0017
S	DCA \KMID
S	TAD \KHI
S	RTL;RTL;RAL
S	AND (0017
S	DCA \KHI
	KDAYS=100*KHI+10*KMID+KLO
C
C
C	[2.3] TEST CLOCK DATE FOR VALIDITY
S	TAD \KDAYS	/GET CLOCK DAY
S	SNA CLA		/SKIP IF NON-ZERO
S	JMP \231	/DAY =ZERO=ERROR
	IF(KDAYS-366)240,240,231
231	WRITE(1,1231)
1231	FORMAT('BAD CLOCK DATE',/)
	CALL EXIT
C
C
C	[2.4] COMPUTE DATE WORD FROM CLOCK DAY
240	IDAY=KDAYS
	IYEAR=IYEAR-1970
	DO 245 MONTH=1,12
	IDAY=IDAY-NDAYS(MONTH)
	IF(IDAY)247,247,245
245	CONTINUE
247	IDAY=IDAY+NDAYS(MONTH)
S	CLA CLL
S	TAD \MONTH	/GET MONTH NO.
S	RTR;RTR;RAR	/MOVE OVER
S	MQL		/STICK IN MQ
S	TAD \IDAY	/GET DAY OF MONTH
S	RTL;RAL		/MOVE OVER
S	MQA;MQL		/TACK ON & REPLACE IN MQ
S	TAD \IYEAR
S	MQA		/ADD ON REST FROM MQ
S	DCA \KDATE	/FORM CLOCK DATE WORD
C
C
C
C	[3.0] IF CLOCK DATE=OS/8 DATE THEN [4.0];ELSE [3.1]
S	TAD \NDATE	/GET OS/8 DATE WORD
S	CIA		/NEGATE
S	TAD \KDATE	/ADD CLOCK DATE WORD
S	SNA CLA		/SKIP IF NOT EQUAL
S	JMP \400
C
C
C	[3.1] RESET OS/8 DATE
	NDATE=KDATE
	WRITE(1,1312)TABLE(MONTH),IDAY,IYEAR
1312	FORMAT('DATE BEING SET TO: ',A3,1X,I2,', 197',I1,/)
S	TAD \NDATE	/GET NEW OS/8 DATE WORD
S	6211		/CDF 10 (FIELD 1)
S	DCAI (7666	/STUFF INTO OS/8 DATE
S	CPAGE 2
S	JMS 45		/RESTORE CURRENT FIELD
S	NOP
C
C
C
C	[4.0] BIRTHDAYS 
S \400,	TAD \NDATE	/GET DATE
S	AND (7770	/STRIP OFF YEAR (WHO NEEDS IT!!)
S	CIA		/NEGATE
S	DCA TODAY	/SAVE FOR COMPARISONS
S	CMA		/SET AC TO -1
S	TAD POINTER	/ADD POINTER TO BDAYS LIST (-1)
S	DCA 13		/PUT IN AUTO-INCREMENT REGISTER
C
	DO 450 MATCH=1,9
S	TAD I 13	/GET A BIRTHDAY
S	TAD TODAY	/IS IT TODAY?
S	SZA CLA		/SKIP IF SO
S	JMP \450	/ELSE CONTINUE
C
	WRITE(1,1401)BNAME(MATCH)
1401	FORMAT(/,' HAPPY BIRTHDAY ',A6,/)
C
450	CONTINUE
C
C
S	TAD \KLOCK	/RTPP MACHINE?
S	SZA CLA		/SKIP IF NOT TRUE
S	JMP \500	/GO DO TIME IF TRUE
C
	CALL EXIT
C
C
S POINTER,BDAYS		/POINTER TO BDAYS LIST
S TODAY,0000		/STORAGE LOCATION
C
C
C
S	CPAGE 11	/KEEP LIST TOGETHER (9D=11O)
S BDAYS,5420		/DR. LIPKIN:	11/2
S	1440		/PETE:		3/4
S	2500		/BRUCE:		5/8
S	3010		/GERSON:	6/1
S	4110		/MORT:		8/9
S	0620		/MARTA:		1/18
S	6020		/JO:		12/2
S	5440		/TOM:		11/4
S	5460		/DR. GORDON	11/6
C
C
C
C
C
C
C	[5.0] PRINT OUT TIME ON TTY & LPT
500	AMPM='AM'
	NHOURS=10*KHH+KHL
	IF(NHOURS)509,502,503
502	NHOURS=12
	GOTO 507
503	IF(NHOURS-24)504,505,509
504	IF(NHOURS-12)507,506,505
505	NHOURS=NHOURS-12
506	AMPM='PM'
507	WRITE(1,1501)NHOURS,KMH,KML,KSH,KSL,AMPM
	WRITE(3,1502)TABLE(MONTH),IDAY,IYEAR
	WRITE(3,1501)NHOURS,KMH,KML,KSH,KSL,AMPM
1501	FORMAT(' TIME  ',I2,':',2I1,':',2I1,' ',A2)
1502	FORMAT(1X,A3,1X,I2,', 197',I1)
C
	CALL EXIT
C
C
509	WRITE(1,1503)
1503	FORMAT(/,' BAD CLOCK TIME',/)
C
C
C
	END
    