.TITLE	DATFDG
.IDENT	/2910.3/
;
;
;
;	WRITTEN BY	RAY DI MARCO
;			29-OCT-80.
;
;	VERSION		291080/03.
;
;
;---------------------------------------------------------------------
;
;
; THIS MODULE CONTAINS THE 'DATFDG' ROUTINE, WHICH IS USED TO MODIFY AND
; COMPARE DATES. THE ROUTINE IS FORTRAN COMPATIBLE. THE CALLING SEQUENCE
; IS -
;
;	CALL	DATFDG	(1,IDATE)
;
;		IDATE = IDATE + 1 MONTH
;
;	CALL	DATFDG	(-1,IDATE)
;
;		IDATE = IDATE - 1 MONTH
;
;	CALL	DATFDG	(2,IDATE,IFLG)
;
;		IFLG	= SIGN (IDATE-SYSDATE)
;
;	CALL	DATFDG	(3,DATE1,DATE2,IFLG)
;
;		IFLG	= SIGN (DATE1-DATE2)
;
;		CALL	DATFDG	(3,IDATE1,IDATE2,IFLG)
;
; IF THE FIRST ARGUMENT IS 1 THEN THE ROUTINE BUMPS UP THE 'IDATE'
; VARIABLE BY ONE MONTH. IF THE FIRST ARGUMENT IS '2' THEN THE 'IFLG'
; VARIABLE CONTAINS -1 ON EXIT IFF THE DATE ARGUMENT IS LESS THAN THE
; SYSTEM DATE.
;
;
;
.SBTTL	MODIFICATIONS
;
; 7-MAR-81	ADD IN TYPE 3 CALL SO THAT 'IFLG=IDATE1-IDATE2'
; 6-APR-81	ADD IN TYPE -1 CALL
;

;
;
;
.SBTTL	DECLARTIONS
;
;
.GLOBL	DATFDG				; ENTRY
.GLOBL	IDATE				; EXTERNAL ROUTINE
;
;
;
	.PSECT	CODE			; OPEN CODE AREA
;	------	----
;
;
;

;
;
;
.SBTTL	ROUTINE	- 'DATFDG'
;
;
;
DATFDG:	CMP	@2(R5),#-1		; MODE -1?
	BNE	200$			; NO -> 200$
;
	MOV	@4(R5),R0		; ARG 2 -> R0
	MOV	R0,R1			; DATE -> R1
	SUB	#32.,R0			; BUMP BACK A MONTH
	BIC	#^C<15.*32.>,R1		; LEAVE MONTH ONLY
	CMP	R1,#<1.*32.>		; MONTH = 1?
	BNE	100$			; NO -> ALL OK
	MOV	@4(R5),R0		; DATE -> R0
	BIC	#<15.*32.>,R0		; LEAVE YEAR/DAYS
	BIS	#<12.*32.>,R0		; LAST MONTH PREVIOUS YEAR
	SUB	#4000,R0		; DOWN YEAR COUNT
100$:	MOV	R0,@4(R5)		; SAVE NEW  DATE
	RETURN				; HOME
;
;
200$:	CMP	@2(R5),#1		; MODE 1?
	BNE	1000$			; NO -> 1000$
;
	MOV	@4(R5),R0		; ARG 2 -> R0
	ADD	#32.,R0			; UP MONTH
	MOV	R0,R1			; DATE -> R1
	BIC	#^C<15.*32.>,R1		; LEAVE MONTH ONLY
	CMP	R1,#12.*32.		; IN RANGE?
	BLOS	300$			; YES -> SKIP
	BIC	#14.*32.,R0		; WRAP AROUND TO MONTH 1
	ADD	#4000,R0		; UP YEAR COUNT
300$:	MOV	R0,@4(R5)		; SAVE NEW DUE DATE
	RETURN				; HOME
;

;
;
1000$:	CMP	@2(R5),#2		; MODE 2
	BNE	2000$			; NO -> SKIP
	MOV	R5,R4			; SAVE POINTER
	MOV	#1777$,R5		; POINT DUMMY ARG BLOCK
	CALL	IDATE			; GET DATE TODAY
	MOV	#1,@6(R4)		; ASSUME GREATER
	CMP	@4(R4),R0		; IS GREATER?
	BHIS	1100$			; YES -> OK
	MOV	#-1,@6(R4)		; MARK AS SMALLER
1100$:	MOV	R4,R5			; RESTORE POINTER
	RETURN				; DONE
;
;
1777$:	.WORD	1			; MODE 1 CALL TO 'IDATE'
;

;
;
;
2000$:	MOV	@4(R5),R0		; IDATE1 -> R0
	CMP	R0,@6(R5)		; COMPARE IDATE1 WITH IDATE 2
	BHI	2100$			; IDATE1 > IDATE2 -> 2100$
	BLO	2200$			;        <           2200$
	CLR	@10(R5)			; SAME
	RETURN				; EXIT
;
2100$:	MOV	#1,@10(R5)		; >
	RETURN
;
2200$:	MOV	#-1,@10(R5)		; <
	RETURN				; HOME
;
;
.END