OPT PAG
 TTL DATE UTILITY
 PAG
*
* SET AND EXAMINE DATE
*
*
* COPYRIGHT (C) 1978 BY
*
* TECHNICAL SYSTEMS CONSULTANTS, INC.
* P.O. BOX 2574
* WEST LAFAYETTE, INDIANA 47906
* (317) 423-5465
*
* Fixed for Y2K - Michael Holley DEC 13, 2001

* GLOBAL VARIABLES

EOL EQU $AC02
FCB EQU $A840
DATE EQU $AC0E
LSTTRM EQU $AC11
FMSCLS EQU $B403
FMS EQU $B406
WARMS EQU $AD03
GETCHR EQU $AD15
PUTCHR EQU $AD18
PSTRNG EQU $AD1E
PCRLF EQU $AD24
OUTDEC EQU $AD39
RPTERR EQU $AD3F
INDEC EQU $AD48

 ORG $A100

DATE0 BRA DATE1

VN FCB 2 VERSION NUMBER
VALUE FDB 0

DATE1 LDAA LSTTRM CHECK TERM CHAR
 CMPA #$D IS IT CR?
 BEQ PDAT
 CMPA EOL IS IT EOL?
 BEQ PDAT
 BSR GETDAT INPUT NUMBER
 BCS DATE4 ERROR?
 CMPA #12 GREATER THAN 12?
 BHI DATE4
 STAA DATE SAVE MONTH
 BSR GETDAT GET DAY NUMBER
 BCS DATE4 ERROR?
 CMPA #31 GREATER THAN 31?
 BHI DATE4
 STAA DATE+1 SAVE DAY
 BSR GETDAT GET YEAR NUMBER
 BCS DATE4 ERROR?
 CMPA #99 GREATER THAN 99?
 BHI DATE4
 STAA DATE+2 SAVE YEAR
 JMP WARMS RETURN TO FLEX

DATE4 LDX #FCB POINT TO FCB
 LDAB #26 SET UP ERROR NUMBER
 STAB 1,X STUFF IN FCB
 JSR RPTERR REPORT ERROR
 LDX #USAGE
 JSR PSTRNG 
 JMP WARMS RETURN TO FLEX

* INPUT DATE DIGIT

GETDAT JSR INDEC INPUT NUMBER
 BCS GETDA4 ERROR?
 TSTB NUMBER THERE?
 BEQ GETDA3
 STX VALUE SAVE VALUE
 LDAA VALUE+1 GET LS PART
 CLC CLEAR ERRORS
 RTS
GETDA3 SEC SET ERRORS
GETDA4 RTS

* PRINT DATE

PDAT JSR PCRLF OUTPUT CR & LF
 LDAA DATE GET MONTH
 LDX #MONTH POINT TO TABLE
PDAT1 DECA CHECK DATE
 BEQ PDAT3
PDAT2 INX FIND MONTH STRING
 TST 0,X
 BNE PDAT2
 INX
 BRA PDAT1
PDAT3 BSR PST GO PRINT IT
 LDAA #$20 OUTPUT SPACE
 JSR PUTCHR
 CLR VALUE
 LDAA DATE+1 GET DAY NUMBER
 STAA VALUE+1
 LDX #VALUE POINT TO IT
 CLRB CLEAR FLAG
 JSR OUTDEC PRINT DAY
 LDX #CST POINT TO STRING
 BSR PST PRINT IT

* OUT YEAR
*
* Check for and convert full year
*
* 1975: $7B7 -> 75
* 1999: $7CF -> 99
*
* 2000: $7D0 -> 0
* 2047: $7FF -> 47
*
* 2048: $800 -> 48
* 2074: $81A -> 74

OUTY CLRB
 LDAA DATE+2 GET YEAR
 CMPA #75 Pivot year?
 BHS OUTY2
 ADDA #100 Next century
OUTY2 ADDA #$6C Add 1900, $76C
 ADCB #$07
 LDX #VALUE Year storage
 STAB 0,X
 STAA 1,X
 CLRB Suppress leading zeros
 JSR OUTDEC PRINT YEAR

 JMP WARMS RETURN TO FLEX

* PRINT STRING

PST LDAA 0,X GET CHARACTER
 BEQ PST2 IS IT NULL?
 JSR PUTCHR OUTPUT CHARACTER
 INX BUMP TO NEXT
 BRA PST REPEAT
PST2 RTS

* TEXT STRINGS

CST FCC ", "
 FCB 0

USAGE FCC "USAGE: DATE MM,DD,YY"
 FCB 4

* MONTH STRINGS

MONTH FCC 'JANUARY'
 FCB 0
 FCC 'FEBRUARY'
 FCB 0
 FCC 'MARCH'
 FCB 0
 FCC 'APRIL'
 FCB 0
 FCC 'MAY'
 FCB 0
 FCC 'JUNE'
 FCB 0
 FCC 'JULY'
 FCB 0
 FCC 'AUGUST'
 FCB 0
 FCC 'SEPTEMBER'
 FCB 0
 FCC 'OCTOBER'
 FCB 0
 FCC 'NOVEMBER'
 FCB 0
 FCC 'DECEMBER'
 FCB 0

 END DATE0