home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG037.ARC
/
CHECKS.Z80
< prev
next >
Wrap
Text File
|
1979-12-31
|
54KB
|
3,253 lines
.Z80
PAGE 60
;
; Checking program for the Big Board
; Written by Ralph Sherman , 15 Hydaway Drive , Forest , Va. 24551
;
; Rev 1.0 -- 3/27/1982 ;FIRST REVISION RELEASED
; REV 1.1 -- 3/28/1982 ;ADDED SPACE BETWEEN DAY AND CHECKS
; ; DURING UNPACK...CMAX NOW $83000
; REV 1.2 -- 3/29/1982 COMPUTED CONSOLE INPUT FOR CPM 1.4
; NOP'S ADDED FOR WARM START AT 100H
; CTRL-X RESETS CURSOR TO BEGINNING
; FIXED BUG IN FWD SPACE CURSOR
; SEND FORM FEEDS WHEN PRINTING TALLY
; REV 1.3 -- 4/1/82 ADDED AUTO NUMBER COMMAND
; RING BELL WHEN INPUTLINE OVERFLOW
; CTRL X CANCELS COMMAND
; CTRL B PUTS CURSOR AT BEGINNING
; ADDED C,D,W INDICATION ON LIST
; ADDED OUTSTANDING INDICATION
; REV 1.4 -- 4/3/82 ADDED W TO HELP COMMAND
; FIXED BUG IN NAME ENTRY
; REV 1.5 -- 1/2/83 BUG1-FIXES ERROR DURING TALLEY WHICH
; CAUSED OVERWRITING PROGRAM
; BUG2-FIXED BUG DURING TALLY WHEN STARTING
; WITH A NEGATIVE STARTING BALANCE
; BUG3-FIXED BUG DURING SAVE WITH 32 CHECKS
;
;
;
;
;
;
;
ASEG
;
;
; SYSTEM DEFINITIONS
;
BELL EQU 7 ;BELL CONTROL CODE
CANCEL EQU 18H ;CONTROL CODE TO CANCEL COMMAND
MOVE EQU 2 ;CTRL CODE TO PUT CURSOR AT BEGINNING
CLRSCR EQU 1AH ;CONSOLE CLEAR SCREEN
BS EQU 8 ;CONSOLE BACKSPACE
FWDSP EQU 0CH ;FORWARD SPACE CONSOLE CURSOR
DELCHAR EQU 4 ;CONSOLE DELETE CHAR AT CURSOR
ADDCHAR EQU 1 ;CONSOLE ADD CHAR AT CURSOR
FORMFD EQU 0CH ;PRINTER FORM FEED CONTROL CHAR
;
DFTUNT EQU 4 ;DEFAULT DRIVE NUMBER
BDOS EQU 5
COLD EQU 0
DMA EQU 80H
FCB EQU 5CH
FCB2 EQU 6CH
OPENFC EQU 15 ;BDOS FUNCTION #
CLSFC EQU 16 ;BDOS FUNCTION #
DELFC EQU 19 ;BDOS FUNCTION #
READFC EQU 20 ;BDOS READ SEQUENTIAL
WRTFC EQU 21 ;BDOS WRITE SEQUENTIAL
MAKEFC EQU 22 ;BDOS CREATE FUNCTION #
RENAFC EQU 23 ;BDOS RENAME FILE FUNCTION #
;
CFILE EQU 3000H ;START OF CHECK FILE
NFILE EQU 5000H ;START OF THE NAME FILE
CKLOC EQU CFILE
NAMLOC EQU NFILE
CCPBAS EQU 8000H ;CAN BE UP TO CCP BASE
;
ORG 0100H
;
START: JP START1
;
GETCMD: LD SP,STACK+128 ;RESET STACK JUST IN CASE
CALL CRLF
XOR A ;ACC. = 0
LD (PTRFLG),A ;TURN PRINTER OFF
CMD2: CALL PRINT
DEFB 'COMMAND',0H
CALL INPUT ;GET CHARACTER FROM CONSOLE
LD (CMD),A ;SAVE THE COMMAND AWAY
PUSH AF
CALL CCRLF
POP AF
LD B,0
LD C,NCMDS
LD HL,CMDS+NCMDS-1
CPDR ;HUNT FOR A MATCH IN CMDS
JR Z,CMD1 ;IF MATCH FOUND, INDEX IN TABLE IS C
CALL PRINT
DEFB ' NO SUCH COMMAND',0H
JP GETCMD
CMD1: LD IX,CMDADR
SLA C ;DOUBLE THE INDEX
ADD IX,BC ;ADD INDEX TO POINTER TO CMD ADDR'S.
LD L,(IX+0) ;LSB FIRST
LD H,(IX+1)
JP (HL) ;JUMP TO THE COMMAND
;
;
; COMMANDS
;
CMDS: DEFB 'BCDFILMNOPQRSTWVG?A'
CMDEND EQU $
NCMDS EQU CMDEND-CMDS ;NUMBER OF COMMANDS
;
CMDADR: DEFW BALANC,CHECK,DEPOS,FIX,CATSRC,PRNT
DEFW MATCH,LIST,OUTSTD,TOGGLE,QUIT,RETURN,SAVE
DEFW TALLY,WITHDR,VALUE,GET,HELP,AUTO
;
; INSERT AUTO NUMBER ON CHECKS
;
AUTO: LD A,'C' ;FAKE CHECK LOOKUP
LD (CMD),A
CALL PROMPT
CALL GETINP
CALL PACKNO
CALL FIXFLG ;SET W FLAG IF SPECIFIED
LD A,(CNUM)
LD (AUTOCN),A
LD A,(CNUM+1)
LD (AUTOCN+1),A
LD A,1
LD (AUTFLG),A ;SET THE AUTO LINENUMBER FLAG
JP GETCMD
;
; HELP- LIST COMMAND SUMMARY
;
HELP: CALL TPRINT
DEFB 13,10,'A-AUTONUMBER CHECK ENTRIES'
DEFB 13,10,'B-LIST CHECK BOOK BALANCE'
DEFB 13,10,'C-ENTER A NEW CHECK'
DEFB 13,10,'D-ENTER A DEPOSIT'
DEFB 13,10,'F-FIX CHECK,WITHDRAWAL,DEPOSIT,OR NAME ENTRY'
DEFB 13,10,'G-GET A NEW CHECK FILE FROM DISK'
DEFB 13,10,'I-INTERROGATE BY FLAG'
DEFB 13,10,'L-LIST CHECKS,DEPOSITS,WITHDRAWALS, OR NAMES'
DEFB 13,10,'M-LIST MATCH BY NAME'
DEFB 13,10,'O-LIST OUTSTANDING CHECKS'
DEFB 13,10,'P-PRINT NEXT COMMAND ON PRINTER'
DEFB 13,10,'Q-QUIT TO CPM'
DEFB 13,10,'R-RETURN A CHECK'
DEFB 13,10,'S-SAVE CURRENT FILE'
DEFB 13,10,'T-LIST MONTHLY TALLY SHEET'
DEFB 13,10,'V-LIST BANK BALANCE'
DEFB 13,10,'W-ENTER A WITHDRAWAL',0DH,0AH,0H ;REV 1.4
;
CALL PRTNUM
JP GETCMD
;
BALANC: CALL YRSTRT
CALL GOTOP
CALL END
BAL2: CALL GETNXT
JR C,BALDON
LD HL,DAY
BIT 7,(HL) ;MINUS IF DEPOSIT
JP NZ,BAL1 ;IF BIT 7=1 THEN NZ
CALL SUBTR
JP BAL2
BAL1: CALL ADD
JP BAL2
BALDON: LD BC,02H
LD HL,SUM
LD DE,BAL
LDIR
CALL PRBAL
JP GETCMD
;
CHECK: LD A,0
LD (PTRFLG),A ; PRINTER OFF
CALL HEAD
CALL TABON
LD A,(AUTFLG) ;CHECK IF AUTO NUMBER IS ON
OR A
JR Z,CHK1
;
; GET THE CHECK NUMBER AND UNPACK IT INTO BUFIN
;
LD A,(AUTOCN)
LD (BINARY),A
LD DE,BUFIN ;TELL PUTBIN WHERE TO PUT ANSWER
LD A,(AUTOCN+1)
OR A ;BIT 8 SET IF WIFE'S CHECKS
JP P,CHK11
LD A,'W' ;PUT W IF CHECK NUMBER
LD (DE),A
CALL OUTPUT ;PUT IT ON SCREEN AND BUFIN
INC DE
LD A,(INPTR)
INC A
LD (INPTR),A
LD (INNUM),A
LD A,(AUTOCN+1)
CHK11: AND 3FH ;STRIP WIFE FLAG IF THERE
LD (BINARY+1),A
LD A,0
LD (BINARY+2),A
CALL BTOD
LD B,4
CALL PUTBIN
;
; NOW UPDATE INPTR AND INNUM
;
PUSH DE
POP HL ; PUT DE INTO HL
LD BC,BUFIN
OR A
SBC HL,BC
LD A,L ;L HAS VALUE FOR POINTER
LD (INPTR),A
LD (INNUM),A
JP CHK2
CHK1: CALL GETNUM
CHK2: CALL GETIN
CALL TABOFF
CALL PACK
CALL CRLF
CALL SAVNXT
;
; NOW UPDATE AUTOCN JUST IN CASE IT IS AUTO NUMBERING
;
LD A,(AUTOCN)
INC A
LD (AUTOCN),A
JP NC,CHK3
LD A,(AUTOCN+1)
INC A
LD (AUTOCN+1),A
CHK3: JP GETCMD
;
DEPOS: LD A,0
LD (PTRFLG),A ; PRINTER OFF
CALL HEAD
CALL TABON
CALL GETNUM
CALL GETIN
CALL TABOFF
CALL PACK
CALL CRLF
CALL SAVNXT
LD HL,DEPNO
INC (HL)
JP GETCMD
CATSRC: CALL PRINT
DEFB CLRSCR,'WHAT CATEGORY FLAG',0
CALL .SYINP
CALL CONOUT
CALL CCRLF
CP 'I'
JR NZ,SRCH1
JP ITAX
SRCH1: CP 'W'
JR NZ,SRCH2
JP WSRC
SRCH2: CP 'R'
JR NZ,SRCH3
JP RSRC
SRCH3: CALL PAKCAT
LD (MASK),A
CALL CRLF
LD A,'C'
LD (CMD),A
CALL HEAD
CALL ZSUM
CALL GOTOP
CALL END
SRC1: CALL GETNXT
JR C,SRCDON
LD A,(MONTH)
AND 0F0H
LD HL,MASK
CP (HL)
JR NZ,SRC1
CALL UNPACK
CALL CRLF
CALL ADD
JP SRC1
SRCDON: CALL PRTOT
JP GETCMD
CDWARG: CALL PRINT
DEFB 0DH,0AH,' C,D,N OR W ?',0
CALL INPUT
CCRLF: PUSH AF ;SAVE THE COMMAND
LD A,NEWLIN ;AND SEND CRLF TO CONSOLE
CALL CONOUT
LD A,LINEFD
CALL CONOUT
POP AF
RET
;
FIX: LD A,0
LD (PTRFLG),A ; INSURE PRINTER IS OFF
CALL CDWARG
CP 'C'
JR Z,FIX1
CP 'D'
JR Z,FIX1
CP 'W'
JR Z,FIX1
CP 'N'
JR NZ,CMDERR
JP NAMFIX
CMDERR: CALL PRINT
DEFB 0DH,0AH,'ONLY C,D,N,OR W ALLOWED',0DH,0AH,0
JP GETCMD
FIX1: LD (CMD),A
CALL PROMPT
CALL GETINP
CALL PACKNO
CALL FIXFLG ;SET W FLAG
CALL FINDNO
CALL HEAD
CALL UNPACK
CALL GETIN ;EDIT BUFIN
CALL PACK
CALL REPLAC
JP GETCMD
LIST: LD A,CLRSCR
CALL OUTPUT ;CLR SCREEN
CALL PRINT
DEFB 13,10,'TYPE MATCH CHAR. OR CR ',0
LD A,'%'
LD (CMNEM),A
LD (CMNEM+1),A
LD (CMNEM+2),A
;
LD HL,CMNEM
LD B,3H
;
LL3: CALL INPUT
CP BLANK
JR Z,LL10
CP NEWLIN
JR Z,LL10
LD (HL),A ;STA
INC HL
DJNZ LL3 ;B IS NOW 0
LL10: LD BC,0000H
CALL CCRLF
LLOOP: LD A,(NIND)
CP C
JR NZ,LL11
JP GETCMD
LL11: LD A,0
LD (INPTR),A
LL5: LD A,(CMNEM)
CP '%'
JR Z,LL6
LD HL,(NB1)
ADD HL,BC ;INDEX DOWN BC ENTRIES
CP (HL)
JR NZ,LL9
LL6: LD A,(CMNEM+1)
CP '%'
JR Z,LL7
LD HL,(NB2)
ADD HL,BC
CP (HL)
JR NZ,LL9
LL7: LD A,(CMNEM+2)
CP '%'
JR Z,LL8
LD HL,(NB3)
ADD HL,BC
CP (HL)
JR NZ,LL9
LL8: LD DE,BUFIN
PUSH BC
CALL GETNAM
PUSH AF
CALL SLOW
POP AF
POP BC
CALL PRNAM
CALL CRLF
CALL KBDTST ;REV 1.4 CHECK ABORT
LL9: INC BC
LD A,C
OR A
JR NZ,LLOOP
CALL PRINT
DEFB 'NAME FILE IS FULL',0DH,0AH,00H
JP GETCMD
;
; PRINT NAME POINTED TO BY BC
;
PRNAM: LD HL,OFFL ;REV 1.4 CHANGED PRNAM: TO LL1:
ADD HL,BC ;GET THE LOW BYTE OFFSET
LD E,(HL) ;PUT IT IN E
LD HL,OFFH ;NOT THE HIGH BYTE OFFSET
ADD HL,BC ;INDEXED BY BC ALSO
LD D,(HL) ;DE NOW HAS OFFSET
LD HL,(NTABLE) ;HL HAS BASE ADDR. OF NAME TABLE
ADD HL,DE ;NOW HL HAS OFFSET ADDED
LD (NPTR),HL ;STORE ADDRESS OF FULL NAME IN NPTR
LL1: LD A,(HL)
CP EOL
JR Z,LL2
CALL OUTPUT
INC HL
JR NZ,LL1
LL2: RET
;
; GET POINTER TO NAME
;
NAMPTR: CALL PRINT
DEFB CLRSCR,'TYPE MNEMONIC NAME',0DH,0AH,0
CALL GETINP
CALL CRLF
LD A,0H
LD (INPTR),A
CALL NAMBYT
JR NC,NP1
CALL PRINT
DEFB 0DH,0AH,'NAME NOT FOUND',0DH,0AH,0
JP GETCMD
NP1: LD (MASK),A
RET
;
; PRINT CHECKS BY NAME MATCH
;
MATCH: CALL NAMPTR
LD A,'C'
LD (CMD),A
CALL HEAD
CALL ZSUM
CALL GOTOP
CALL END
MAT2: CALL GETNXT
JR C,MATRET
LD A,(NAME)
LD HL,MASK
CP (HL)
JR NZ,MAT2 ;WRONG NAME
CALL UNPACK
CALL CRLF
CALL ADD
JP MAT2 ;LOOP AGN
MATRET: CALL PRTOT
JP GETCMD
;
; PRINT OUTSTANDING CHECKS
;
OUTSTD: LD A,'C'
LD (CMD),A
CALL HEAD
CALL ZSUM
CALL GOTOP
CALL END
OUTS1: CALL GETNXT
JR C,OUTS2 ;DONE
LD A,(DAY)
AND 0C0H
JR NZ,OUTS1 ; SKIP D & W
LD HL,CNUM+1
BIT 6,(HL)
JR NZ,OUTS1 ;R FLAG SET
CALL UNPACK
CALL CRLF
CALL ADD
JP OUTS1
OUTS2: CALL TPRINT
DEFB 0DH,0AH,'OUTSTANDING',0H
CALL PRTOT
JP GETCMD
JP GETCMD
;
; LIST CHECKS, DEPOSITS OR WITHDRAWALS
;
PRNT: CALL CDWARG
CP 'N'
JR NZ,PRNT1
JP LIST
PRNT1: LD (CMD),A
CALL GETMO
CALL HEAD
LD A,(CMD)
CP 'W'
JR NZ,PR1
LD A,40H ;W FLAG
JR Z,PR3
PR1: CP 'D'
JR NZ,PR2
LD A,80H ;D FLAG
JR Z,PR3
PR2: LD A,0 ; NOT W OR D
PR3: LD (MASK),A
CALL GOTOP
CALL END
CALL ZSUM
PR4: CALL KBDTST ;REV 1.4 CHECK ABORT
CALL GETNXT
JR C,PDDONE
CALL MTEST
JR NZ,PR4
LD A,(DAY)
AND 0C0H
LD HL,MASK
CP (HL)
JR NZ,PR4
CALL UNPACK
CALL CRLF
CALL ADD
JP PR4
PDDONE: CALL PRTYP
CALL PRTOT
LD A,0 ; RESET DEFAULT MONTH
LD (OUTMO),A
JP GETCMD
;
; PRINT TYPE OF LISTING DONE
;
PRTYP: LD A,(CMD)
CP 'C'
JR NZ,PRTYP1
CALL TPRINT
DEFB 0DH,0AH,'CHECKS',0H
RET
PRTYP1: CP 'D'
JR NZ,PRTYP2
CALL TPRINT
DEFB 0DH,0AH,'DEPOSITS',0H
RET
PRTYP2: CALL TPRINT
DEFB 0DH,0AH,'WITHDRAWALS',0H
RET
;
; QUIT AND RETURN TO CP/M
;
QUIT: CALL PRINT
DEFB CLRSCR,'SAVE CHECKS FIRST? (Y/N)',0
CALL .SYINP
CP 'Y'
JR NZ,QU1
CALL PRTNAM
CALL SAVCHK
CALL SAVNAM
JP QU2
QU1: CP 'N'
JR NZ,QUIT
QU2: LD HL,(OLDSP)
LD SP,HL
JP COLD
;
; RETURN AN OUTSTANDING CHECK
;
RETURN: CALL PRINT
DEFB CLRSCR,'RETURN WHAT CHECK #',0
LD A,'C'
LD (CMD),A
CALL GETINP
CALL PACKNO
CALL FIXFLG
CALL FINDNO
CALL HEAD
CALL UNPACK
LD DE,0000H
LD A,(INPTR)
LD E,A
LD HL,BUFIN
ADD HL,DE
LD A,'R'
LD (HL),A
CALL OUTPUT
LD HL,INPTR
INC (HL)
LD HL,INNUM
INC (HL)
CALL CRLF
CALL PACK
CALL REPLAC
JP GETCMD
;
; SAVE THE CURRENT DATA ON THE DISK
;
SAVE: CALL PRTNAM
CALL SAVCHK
CALL SAVNAM
JP GETCMD
;
; PRINT OUT A MONTHLY TALLY SHEET
;
TALLY: CALL TALPR
JP GETCMD
;
; ENTER A WITHDRAWAL
;
WITHDR: LD A,0
LD (PTRFLG),A
CALL HEAD
CALL TABON
CALL GETNUM
CALL GETIN
CALL PACK
CALL CRLF
CALL SAVNXT
LD HL,WITHNO
INC (HL)
CALL TABOFF
JP GETCMD
;
; PRINT OUT THE BANK BALANCE
;
VALUE: CALL YRSTRT
CALL GOTOP
CALL END
VAL2: CALL GETNXT
JR C,VALDON
LD HL,DAY
BIT 7,(HL)
JR NZ,VAL1 ;DEPOSIT ADD
BIT 6,(HL)
JR NZ,VAL3
LD HL,CNUM+1 ;IGNORE OUTSTD
BIT 6,(HL)
JR Z,VAL2
VAL3: CALL SUBTR
JP VAL2
VAL1: CALL ADD
JP VAL2
VALDON: CALL TPRINT
DEFB CLRSCR,'BANK BALANCE',0DH,0AH,0
JP BALDON
;
; GET A NEW DATA FILE FROM DISK
;
GET: CALL PUTNAM
GETX: CALL LDCHK
CALL LDNAM
JP GETCMD
;
; SEND CRLF TO CONSOLE AND RESET OUTPOS
;
CRLF: LD A,00H
LD (OUTPOS),A
LD A,NEWLIN
CALL OUTPUT
LD A,LINEFD
JP OUTPUT
;
; GET A CONSOLE INPUT WITHOUT ECHO, SET UPPER CASE
; RETURN TO COMMAND MODE IF CTRL C
;
.SYINP: CALL SYSINP
CALL CASE
CP CANCEL
RET NZ
LD A,0
LD (AUTFLG),A ;TURN AUTO NUMBER MODE OFF
JP GETCMD
;
; PRINT HEADERS
;
HEAD: LD A,(CMD)
CP 'C'
JR Z,CHEAD
CP 'D'
JR Z,DHEAD
CP 'W'
JR Z,WHEAD
POP AF ;CLEAN UP THE STACK
JP CMDERR
;
; PRINT CHECK HEADER
;
CHEAD: CALL TPRINT
DEFB CLRSCR,'CHK# ',0
JP HDR
;
; PRINT WITHDRAW HEADER
;
WHEAD: CALL TPRINT
DEFB CLRSCR,'WITH# ',0
JP HDR
;
; PRINT DEPOSIT HEADER
;
DHEAD: CALL TPRINT
DEFB CLRSCR,'DEP# ',0
HDR: CALL TPRINT
DEFB 'MO DA AMOUNT NAME FLAGS',0DH,0AH,0
RET
;
;
; CONVERTS BINARY NUMBER TO ASCII DECIMAL STRING
; BINARY NUMBER IN BINARY
; DECIMAL IN STRING
;
BTOD: PUSH HL
LD C,7H
BT.10: CALL .DIVI0
LD B,0 ;SET UP POINTER TO STRING
LD A,(REMAIN)
ADD A,30H
LD HL,STRING
ADD HL,BC
LD (HL),A
LD B,C ;SET LOOP COUNTER TO C
DEC C
DJNZ BT.10
POP HL
RET
.DIVI0: LD A,0
LD (REMAIN),A
LD HL,REMAIN
LD B,25
JR DI.10
DI.05: RL (HL)
DI.10: OR A
LD A,(REMAIN)
SUB 0AH
JR C,DI.21
LD (REMAIN),A
DI.21: CCF
DI.20: LD IX,BINARY
RL (IX+0)
RL (IX+1)
RL (IX+2)
DJNZ DI.05
RET
;
; CONVERTS A DECIMAL ASCII STRING TO A BINARY NUMBER
; DEC ASCII IN STRING
; BINARY NUMBER IN BINARY
;
;
DTOB: LD A,0
LD (XIND),A
LD (REMAIN),A
LD (REMAIN+1),A
LD (REMAIN+2),A
LD (BINARY),A
LD (BINARY+1),A
LD (BINARY+2),A
LD HL,STRING
DTOB1: LD A,(HL)
CALL DIGIT
JR Z,DTOB10
CALL PRINT
DEFB 0DH,0AH,'ALPHA IN NUMERIC INPUT',0DH,0AH,0
JP GETCMD
DTOB10: CALL MPY10
LD A,B
LD IY,BINARY
ADD A,(IY+0)
LD (BINARY),A
JR NC,DTOB2
INC (IY+1)
JR NZ,DTOB2
INC (IY+2)
LD A,(BINARY+2)
CP 7FH
JR C,DTOB2 ; CHK VAL OK
CALL PRINT
DEFB 0DH,0AH,'CHECK VALUE TOO BIG',0DH,0AH
JP GETCMD
DTOB2: LD IX,XIND
INC (IX+0)
INC HL
LD A,(IX+0)
CP 08H
JR NZ,DTOB1
RET ; CONVERSION COMPLETE
;
; MULTIPLY BINARY BY 10
;
MPY10: PUSH BC
LD B,10
LD A,0
LD (REMAIN),A
LD (REMAIN+1),A
LD (REMAIN+2),A
LD IX,BINARY
MP.10: LD A,(REMAIN)
ADC A,(IX+0)
LD (REMAIN),A
LD A,(REMAIN+1)
ADC A,(IX+1)
LD (REMAIN+1),A
LD A,(REMAIN+2)
ADC A,(IX+2)
LD (REMAIN+2),A
DJNZ MP.10
POP BC
LD (BINARY+2),A
LD A,(REMAIN+1)
LD (BINARY+1),A
LD A,(REMAIN)
LD (BINARY),A
RET
;
; CHECK FOR DECIMAL DIGIT
; B RETURNS VALUE OF DIGIT IN HEX
;
DIGIT: PUSH HL
LD HL,DIG+9
LD B,9
DIG.10: CP (HL)
JR Z,DIG.20
DEC HL
DEC B
JP P,DIG.10
DIG.20: POP HL
RET ; Z=1 IF DIGIT
;
DIG: DEFB '0123456789ABCDEF'
;
;
;
; RESET INNUM AND INPTR
; IF WITHDRAWAL OR DEPOSIT GET NUMBER
; IF AUTO-NUMBER, THEN GET THE CHECK NUMBER
; ELSE RETURN
;
GETNUM: LD A,0
LD (INNUM),A
LD (INPTR),A
LD A,(CMD)
CP 'C'
RET Z
CP 'D'
JR Z,GETDEP
; ELSE GET WITHDRAWAL #
LD A,(WITHNO)
JP GN2
GETDEP: LD A,(DEPNO)
GN2: LD (BINARY),A
LD A,0
LD (BINARY+1),A
LD (BINARY+2),A
CALL BTOD
LD B,3 ;LOOP COUNTER
LD IX,STRING+5
LD IY,BUFIN
GN3: LD A,(IX+0)
LD (IY+0),A
INC IX
INC IY
CALL OUTPUT
LD HL,INNUM
INC (HL)
LD HL,INPTR
INC (HL)
DJNZ GN3
RET
;
; FILL BUFIN FROM KBD
; RETURN ON CR OR #LINEFD
; GETINP RESETS INPTR & INNUM TO 0
; GETIN ASSUMES INPTR & INNUM VALID
;
GETINP: LD A,0H
LD (INNUM),A
LD (INPTR),A
;
GETIN: CALL .SYINP
;
; IF INPUT WILL GO TO PRINTER THEN PRINT CHAR ON CONSOLE
;
PUSH AF ;SAVE THE CHAR
LD A,(PTRFLG)
OR A
JR Z,NOTPTR
POP AF
PUSH AF
CALL CONOUT
NOTPTR: POP AF
;
CALL TABNXT
CP BS
JR NZ,GI1
;
; BACKSPACE
;
PUSH AF ;SAVE THE BACKSPACE CHAR
LD A,(INPTR) ;CHECK IF AT THE BEGINNING
OR A ;IS INPTR ZERO
JR NZ,NOTBEG ;NOT AT BEGINNING, NOW BACKSPACE
POP AF
JP GETIN ;ELSE IGNORE THE BACKSPACE
NOTBEG: DEC A ;UPDATE INPTR
LD (INPTR),A
POP AF ;NOW SEND BACKSPACE TO VIDEO
CALL OUTPUT
JP GETIN ;AND GET NEXT CHARACTER
;
; INSERT
;
GI1: CP ADDCHAR ; CTRL A ADD SPACE AT CURSOR?
JR NZ,GI2
LD BC,0000H ;SET IT TO ZERO
LD DE,INPTR ;DE POINTS TO INPTR
LD HL,INNUM ;HL POINTS TO INNUM
LD A,(HL)
CP BUFSIZ-1 ;MAKE SURE INSERT DOES NOT
JR Z,GETIN ;OVERFLOW THE BUFFER
LD A,(DE) ;GET VALUE OF INPTR
CP (HL) ;IS IT AT THE END OF THE BUFFER
JR Z,GETIN ;IF SO IGNORE INSERT
INC (HL) ;BUFIN WILL HAVE ONE MORE CHAR
LD A,(HL) ;GET INNUM
LD C,A ;PUT IT INTO INDEX
LD IY,BUFIN
ADD IY,BC ;START AT THE OLD END OF BUFIN
GI10: LD A,(IY-1) ;GET A CHAR
LD (IY+0),A ;AND MOVE IT TO RIGHT ONE CHAR
DEC IY ;NEXT CHAR DOWN
DEC C ;DEC POINTER
LD A,(DE) ;GET INPTR
CP C ;IS POINTER AT INPTR
JR NZ,GI10 ;CONTINUE MOVING UNTIL EQUAL
LD A,BLANK
LD (IY+0),A ;PUT BLANK AT INPTR POSITION
CALL FIXVID
GI11: JP GETIN
;
; DELETE CHARACTER AT CURSOR
;
GI2: CP DELCHAR
JR NZ,GI3
LD DE,INPTR ;DE POINTS TO INPTR
LD A,(DE)
LD HL,INNUM ;HL POINTS TO INNUM
CP (HL)
JR Z,GETIN ;ABORT IF INPTR=INNUM
LD BC,0000H ;INITIALIZE BC
LD C,A ;BC NOW INDEX INTO BUFIN
LD IX,BUFIN
ADD IX,BC ;IX NOW POINTS INTO BUFIN
GI20: LD A,(IX+1) ;MOVE NEXT CHARACTER
LD (IX+0),A ;DOWN TO REPLACE ONE POINTED TO
INC C ;C IS INPTR + 1
INC IX ;MOVE UP ONE CHARACTER
LD A,C ;AND IF INPTR + 1 IS NOT
CP (HL) ;EQUAL TO INNUM MOVE ANOTHER
JR NZ,GI20
DEC (HL) ;DEC INNUM BECUZ ONE CHAR IS GONE
CALL FIXVID ;AND UPDATE THE DISPLAY
JP GETIN
;
; FWD SPACE
;
GI3: CP FWDSP ; FWD SPACE
JR NZ,GI4
LD A,(INPTR)
LD HL,INNUM
CP (HL)
JR NZ,GI40
JP GETIN
GI40: INC A
LD (INPTR),A
LD A,FWDSP ;NOW FORWARD SPACE CURSOR
CALL OUTPUT
JP GETIN
;
; TEST FOR MOVE TO SET CURSOR AT BEGINNING OF BUFFER
;
GI4: CP MOVE ;MOVE THE CURSOR?
JR NZ,GI41
LD A,0DH
CALL OUTPUT ;SET CURSOR AT BEGINNING
LD A,0
LD (INPTR),A ;RESET INPTR
JP GETIN
;
; RETURN FROM GETIN ON LINE FEED OR CARRIAGE RETURN
;
GI41: CP LINEFD
RET Z
CP NEWLIN
RET Z
;
; IGNORE OTHER CONTROL CODES AND PUT VALID CHAR. IN BUFFER
;
GI5: CP 20H ;IGNORE REST OF CONTROL CODES
JP C,GETIN
LD HL,BUFIN
LD BC,0000H
PUSH AF
LD A,(INPTR)
LD C,A
ADD HL,BC
POP AF
LD (HL),A
CALL OUTPUT
LD A,(INPTR)
INC A
LD (INPTR),A
LD HL,INNUM
CP (HL)
JP C,GETIN ; INPTR<INNUM
JP Z,GETIN
LD (HL),A
CP 32
JP NZ,GETIN
INERR: LD A,BELL
CALL OUTPUT
CALL PRINT
DEFB 0DH,0AH,'INPUT BUFFER OVERFLOW',0DH,0AH,0
JP GETCMD
;
; UPDATE VIDEO DISPLAY
; RESET CURSOR TO INPTR
;
FIXVID: LD A,(INNUM) ;WRITE OUT BUFIN
LD C,A
CALL OVRWRT
;
; NOW WRITE SPACES UNTIL BUFSIZ TO ERASE EVERYTHING
;
FV1: CP BUFSIZ
JR Z,FV2
LD A,BLANK
CALL OUTPUT
INC B
LD A,B
JP FV1
;
; NOW OVERWRITE UNTIL INPTR
;
FV2: LD A,(INPTR)
LD C,A
CALL OVRWRT
RET
;
OVRWRT: LD A,NEWLIN ;START AT THE BEGINNING
CALL OUTPUT
LD B,0 ;B IS CHAR. COUNTER
LD IX,BUFIN ;IX IS POINTER INTO BUFIN
WRTNXT: LD A,(IX+0) ;GET A CHARACTER
CALL OUTPUT ;AND OUTPUT IT TO CONSOLE
INC B ;BUMP THE CHAR. COUNTER
INC IX ;AND THE POINTER
LD A,B
CP C ;COMPARE CHAR. CNTR TO LIMIT
JR NZ,WRTNXT ;AND LOOP UNTIL END
RET
;
; PACK BUFIN INTO BUFFER
;
PACKNO: LD A,0
LD (WIFE),A ; RESET FLAG
LD (INPTR),A ; GETCMDNING OF BUFIN
LD A,(BUFIN)
CP 'W'
JR NZ,P1
LD A,1
LD (WIFE),A
LD IY,INPTR
INC (IY+0)
;
; GET CK,WITHDR,OR DEPOSIT #
;
P1: CALL GETDEC ; PUT # INTO STRING
CALL DTOB
LD A,(BINARY)
LD (CNUM),A
LD A,(BINARY+1)
AND 3FH
LD (CNUM+1),A
RET
;
; PACK TAKES THE CONTENTS OF BUFIN AND PACKS THE DATA
; INTO 8 BYTES AND STORES IT IN THE BUFFER
;
PACK: CALL PACKNO
;
; GET MONTH
;
CALL GETDEC
CALL DTOB
LD A,(BINARY)
AND 0FH
LD (MONTH),A
;
; GET DAY
;
CALL GETDEC
CALL DTOB
LD A,(BINARY)
AND 3FH
LD (DAY),A
;
; GET CHECK VALUE
;
CALL GETVAL
CALL DTOB
LD A,(BINARY+2)
LD (CVAL+2),A
LD A,(BINARY+1)
LD (CVAL+1),A
LD A,(BINARY)
LD (CVAL),A
;
; GET NAME
;
CALL NAMBYT
JR C,P3 ; NAME NOT FOUND
LD (NAME),A
;
; FIX FLAGS
;
JP FIXFLG ; RETURN
;
P3: LD (NAME),A ; PUT 0 IN TEMPORARILY
CALL FIXFLG
CALL PRINT
DEFB 0DH,0AH,'NEW NAME (Y/N)',0DH,0AH,0
CALL INPUT
CP 'Y'
JR Z,P4
JP GETCMD
P4: CALL FIXNAM
LD (NAME),A
RET
;
; PUT NEXT BUFIN ENTRY INTO STRING
;
GETDEC: LD B,8 ; CLEAR STRING
LD A,'0'
LD HL,STRING+7
PD1: LD (HL),A
DEC HL
DJNZ PD1
PD2: CALL SETHL ;HL=BUFIN+INPTR
LD A,(HL)
CP BLANK ; IGNORE LEADING SPACES
JR NZ,PD3
LD A,(INPTR)
INC A
LD (INPTR),A
JR NZ,PD2
PD3: LD A,(HL)
CP BLANK ; RETURN ON NEXT SPACE
JR NZ,PD4
PDRET: RET
PD4: CP '.'
JR Z,PDRET
CALL PUTSTR
NXTNUM: LD A,(INPTR)
INC A
LD (INPTR),A
CALL SETHL
LD IX,INNUM
CP (IX+0)
JR NZ,PD3
RET
;
; SET HL TO BUFIN+INPTR
;
SETHL: PUSH AF ;DON'T DESTROY IT
LD A,(INPTR)
LD E,A
LD D,0
LD HL,BUFIN
ADD HL,DE
POP AF
RET
;
;
; GET CHECK VALUE
; ALL DOLLARS UNLESS . FOUND
;
GETVAL: CALL GETDEC
CP '.'
JR Z,CENTS
LD A,'0' ; AMOUNT IN DOLLARS
CALL PUTSTR
LD A,'0'
JP PUTSTR ; RETURN
CENTS: INC HL
LD A,(HL)
CP BLANK
JR Z,VALERR
INC HL
LD A,(HL)
CP BLANK
JR Z,VALERR
INC HL
LD A,(HL)
CP BLANK
JR NZ,VALERR
JP NXTNUM ; CENTS OK
VALERR: CALL PRINT
DEFB 0DH,0AH,'CHECK VALUE ERROR',0DH,0AH,0
JP GETCMD
;
; PUT ACC INTO STRING
;
PUTSTR: LD B,8
PUSH AF
LD IY,STRING
PS1: LD A,(IY+1)
LD (IY+0),A
INC IY
DJNZ PS1
POP AF
LD (IY-1),A
RET
;
; SET FLAG BITS
;
FIXFLG: LD A,(WIFE)
OR A ;SET THE FLAG
JR Z,FF0
LD A,(CNUM+1) ;SET WIFE FLAG
OR 080H
LD (CNUM+1),A
FF0: LD A,(CMD)
CP 'C'
JR Z,FF1
CP 'W'
JR Z,FW1
CP 'D'
JR NZ,FXERR
;
; SET DEPOSIT FLAG
;
LD A,(DAY)
OR 080H
LD (DAY),A
JR NZ,FF1 ; JUMP
FXERR: CALL PRINT
DEFB 0DH,0AH,'CMD ERROR IN FIXFLG',0DH,0AH,0
JP GETCMD
;
; SET WITHDRAW FLAG
;
FW1: LD A,(DAY)
OR 040H
LD (DAY),A
FF1: LD A,(INPTR)
LD B,A
LD A,(INNUM)
CP B
JR NZ,FF4
RET ; NO MORE FLAGS
FF4: LD HL,BUFIN
LD DE,0000H
LD A,(INPTR)
LD E,A
ADD HL,DE
LD A,(HL)
CP BLANK
JR Z,NXTFLG
CP 'R'
JR NZ,FF2
LD A,(CNUM+1) ;SET RETURNED FLAG
OR 040H
LD (CNUM+1),A
JP NXTFLG
FF2: CP 'I'
JR NZ,FF3
LD A,(CVAL+2) ;SET I TAX FLAG
OR 80H
LD (CVAL+2),A
JP NXTFLG
FF3: CP 'W'
JR NZ,FF6
LD A,(CNUM+1)
OR 80H ; SET WIFE FLG
LD (CNUM+1),A
JP NXTFLG
FF6: CALL PAKCAT
LD B,A
LD A,(MONTH)
OR B
LD (MONTH),A
NXTFLG: LD A,(INPTR)
INC A
LD (INPTR),A
INC HL
JP FF1
;
; INVALID CAT FLAGS ARE W,I,R
CAT: DEFB 'NCDEFGHMPSU%%%%%'
; % ARE SPARES
;
;
; UNPACK BUFFER INTO BUFIN
; INPTR AND INNUM SET TO END OF BUFIN
;
UNPACK: LD A,0
LD HL,BUFFER
LD DE,BUFIN
LD A,(BUFFER)
LD (BINARY),A
LD A,(BUFFER+1)
AND 3FH
LD (BINARY+1),A ; UNPACK CHECK #
LD A,0
LD (BINARY+2),A
CALL BTOD
LD B,4
CALL PUTBIN
;
; UNPACK MONTH
;
LD A,(MONTH)
AND 0FH
LD (BINARY),A
CALL BTOD
LD B,4
CALL PUTBIN
;
; UNAPCK DAY
;
LD A,(DAY)
AND 3FH
LD (BINARY),A
CALL BTOD
LD B,5
CALL PUTBIN
;
; INSERT SPACE BETWEEN DAY AND CHECK VALUE FOR LARGE CHECKS
;
LD A,20H
LD (DE),A
INC DE
CALL OUTPUT
;
; UNPACK VALUE
;
LD A,(CVAL)
LD (BINARY),A
LD A,(CVAL+1)
LD (BINARY+1),A
LD A,(CVAL+2)
AND 7FH
LD (BINARY+2),A
CALL BTOD
LD A,1
LD (V),A ;SET UP FOR CENTS MODE
LD B,1 ;SET UP FOR ALL OUTPUT
CALL PUTBIN
LD A,0
LD (V),A
;
; UNPACK NAME
;
LD A,(NAME)
LD C,A
CALL GETNAM
;
; UNPACK FLAGS
;
UPFLG: LD HL,CNUM+1
BIT 7,(HL)
JR Z,UP2
LD A,'W'
CALL OUTPUT
LD (DE),A
INC DE ;DE IS POINTER INTO BUFIN
UP2: LD IY,CNUM+1
BIT 6,(IY+0)
JR Z,UP3
LD A,'R'
CALL OUTPUT
LD (DE),A ;PUT R INTO BUFIN
INC DE
UP3: LD IY,CVAL+2
BIT 7,(IY+0)
JR Z,UP4
LD A,'I'
CALL OUTPUT
LD (DE),A ;PUT I INTO BUFIN
INC DE
;
; UNPACK CATEGORY
;
UP4: LD A,(MONTH)
AND 0F0H
RRCA
RRCA
RRCA
RRCA
LD C,A ;C IS OFFSET INTO CAT STRING
LD B,0
LD IY,CAT
ADD IY,BC ;IY NOW POINTS TO C'TH ENTRY IN CAT
LD A,(IY+0)
CP '%'
JR Z,UPRET
CP 'N'
JR Z,UPRET
CALL OUTPUT
LD (DE),A
INC DE ;DE POINTS TO BUFIN
UPRET: PUSH DE
POP HL ;EXCHANGE DE AND HL
LD BC,BUFIN
OR A ;CLEAR CARRY JUST TO BE SURE
SBC HL,BC ;COMPUTE INDEX INTO BUFFER
LD A,L
LD (INPTR),A
LD (INNUM),A
;
; NOW PRINT THE FULL NAME ON THE SCREEN
; RETURN IF THIS IS A TALLY COMMAND ELSE
; TAB TO COLUMN 40 THEN PRINT THE NAME
;
LD B,A
LD A,(CMD)
CP 'T'
LD A,B ;RESTORE A=INPTR,INNUM
RET Z
LD B,A
LD A,40
SUB B
LD B,A
UPLP: LD A,BLANK
CALL OUTPUT
DJNZ UPLP
LD A,(NAME)
LD C,A
CALL PRNAM
;
; NOW RETURN THE CURSOR TO COLUMN SET BY INPTR
;
LD A,0DH ;RETURN CURSOR TO BEGINNING
CALL OUTPUT
LD A,(INPTR)
LD B,A
UPLP1: LD A,FWDSP
CALL OUTPUT
DJNZ UPLP1
LD A,(INPTR)
RET
;
; B CONTAINS POINTER TO STRING
; HL POINTS TO BUFFER
; LEADING 'S REPLACED BY SPACES
; IF V=1 THEN (.) INSERTED
;
PUTBIN: PUSH BC
LD C,B
LD B,0
PTB2: LD IY,STRING
ADD IY,BC ;IY POINTS TO B'TH ENTRY IN STRING
LD A,(IY+0)
CP '0'
JR NZ,PTB1
LD A,BLANK
CALL OUTPUT
LD (DE),A
INC DE ;INCREMENT BUFFER POINTER
INC C ;INCREMENT INDEX INTO STRING
LD A,C
CP 6
JR NZ,PB3
LD A,(V)
OR A ;SET THE FLAGS
JR NZ,PTB1
PB3: CP 8
JR NZ,PTB2
POP BC
LD A,E
LD (INPTR),A
RET
PTB1: LD A,C
CP 6
JR NZ,PB2
LD A,(V)
OR A
JR Z,PB2
LD A,'.'
CALL OUTPUT
LD (DE),A
INC DE
PB2: LD IY,STRING
OR A ;CLEAR CARRY
ADD IY,BC
LD A,(IY+0)
CALL OUTPUT
LD (DE),A
INC DE
INC C
LD A,C
CP 8
JR NZ,PTB1
POP BC
LD A,E
LD (INPTR),A
RET
;
; GET INPUT FROM CONSOLE WITH ECHO, COMMAND MODE ON CTRL C
;
INPUT: CALL SYSIN
CP CANCEL ;CANCEL THE COMMAND IN PROCESS?
JP NZ,CASE
LD A,0
LD (AUTFLG),A ;CANCEL THE AUTO NUMBER MODE
JP GETCMD
;
;
; ENTER CHECK BUFFER INTO CFILE AT END
;
SAVNXT: LD HL,(CKSTRT)
LD DE,(FILSIZ)
ADD HL,DE
LD (TPTR),HL
LD A,E
ADD A,08H ;INCREMENT BY 8 BYTES
LD E,A
JR NC,SAV1
INC D
SAV1: LD (FILSIZ),DE ;UPDATE FILE SIZE
;
;NOW CHECK IF CHECK FILE WILL OVER WRITE NAME FILE
;
LD HL,(NAMES)
LD DE,(TPTR)
OR A ;CLEAR THE CARRY
SBC HL,DE
JR NC,REPLAC ;TPTR<NAMES
;
;IF NAMES WOULD BE OVERWRITTEN THEN DEC FILSIZ BY 8
;AND RETURN TO GET CMD AFTER ERROR MESSAGE
;
LD HL,(FILSIZ)
LD B,0
LD C,8
OR A ;CLEAR THE CARRY
SBC HL,BC
LD (FILSIZ),HL
CALL PRINT
DEFB CLRSCR,'CHECK FILE FULL',0DH,0AH,0
JP GETCMD
;
; ENTER HERE WITH TPTR SET FOR REPLACE
;
REPLAC: LD B,8 ;SET UP TO MOVE 8 BYTES
LD HL,BUFFER
LD IY,(TPTR)
REP1: LD A,(HL)
LD (IY+0),A
INC HL
INC IY
DJNZ REP1
RET
PROMPT: CALL PRINT
DEFB 0DH,0AH,'ENTER # (W # FOR WIFES CHECK)',0
RET
;
; FIND # MATCH IN CFILE
; RETURN LOAD ENTRY INTO BUFFER
; TPTR SET TO LOCATION TO REPLACE
;
FINDNO: CALL END
LD HL,(CKSTRT)
LD (TPTR),HL
F2: LD HL,(TPTR)
LD IY,BUFFER
LD A,(HL)
CP (IY+0)
JR NZ,F1
INC HL
LD A,(HL)
AND 0BFH ;CLEAR RETURN FLAG
CP (IY+1)
JR Z,FOUND
F1: CALL INCNXT
;
; NOW CHECK IF TPTR IS AT THE END OF THE CHECK FILE
;
LD HL,(BUFEND)
LD DE,(TPTR)
OR A
SBC HL,DE
JR NC,F2 ;TPTR<BUFEND
CALL PRINT
DEFB 0DH,0AH,'ENTRY NOT FOUND',0DH,0AH,0
JP GETCMD
FOUND: LD A,(CMD)
CP 'W'
JR NZ,F5
LD HL,(TPTR)
LD BC,0006 ;LOOK AT 6TH ENTRY
ADD HL,BC
LD A,(HL)
AND 40H ;IS W FLAG SET
JR Z,F1 ; NO GOTO NEXT ENTRY
JR NZ,F4
F5: CP 'D'
JR NZ,F6
LD HL,(TPTR)
LD BC,0006H ;LOOK AT 6TH ENTRY
ADD HL,BC
LD A,(HL)
AND 080H ;IS D FLAG SET
JR Z,F1 ; NO GOTO NEXT ENTRY
JR NZ,F4
F6: CP 'C'
JR Z,F7 ; OK
F8: POP AF ;CLEAN UP THE STACK
JP CMDERR
F7: LD HL,(TPTR)
LD BC,0006H ;LOOK AT 6TH ENTRY
ADD HL,BC
LD A,(HL)
AND 0C0H
CP 0
JR NZ,F1
F4: LD B,8 ;TRANSFER ENTRY TO BUFFER
LD HL,(TPTR)
LD IY,BUFFER
F9: LD A,(HL)
LD (IY+0),A
INC HL
INC IY
DJNZ F9
RET ;TPTR AT ENTRY LOC.
;
; INC TPTR TO NEXT ENTER
;
INCNXT: LD HL,(TPTR)
LD BC,0008
ADD HL,BC
LD (TPTR),HL
RET
;
; COMPUTE CFILE END
;
END: LD HL,(CKSTRT)
LD DE,(FILSIZ)
ADD HL,DE
LD (BUFEND),HL
RET
;
; SET TPTR TO GETCMD OF CFILE
;
GOTOP: LD HL,(CKSTRT)
LD (TPTR),HL
RET
;
; FIRST TEST DONE ELSE
; TRANSFER TPTR ENTRY TO BUFFER
; THEN INCREMENT TPTR TO NEXT
;
GETNXT: LD HL,(TPTR)
LD BC,(BUFEND)
OR A
SBC HL,BC
JR NZ,GTNXT1
SCF
RET ;CARRY SET WHEN EOF
;
; NOW MOVE 8 BYTES FROM TPTR TO BUFFER
;
GTNXT1: LD B,8
LD IY,BUFFER
LD HL,(TPTR)
GTNXT2: LD A,(HL)
LD (IY+0),A
INC HL
INC IY
DJNZ GTNXT2
CALL INCNXT
SCF
CCF
RET
;
; ZERO SUM
;
ZSUM: LD A,0
LD (SUM),A
LD (SUM+1),A
LD (SUM+2),A
RET
;
; ADD CVAL TO SUM
;
ADD: LD A,(CVAL+2)
AND 7FH
LD (CVAL+2),A
ADD0: OR A ;CLEAR THE CARRY FLAG
ADD1: LD A,(CVAL)
LD B,A
LD A,(SUM)
ADC A,B
LD (SUM),A
LD A,(CVAL+1)
LD B,A
LD A,(SUM+1)
ADC A,B
LD (SUM+1),A
LD A,(CVAL+2)
LD B,A
LD A,(SUM+2)
ADC A,B
LD (SUM+2),A
RET
;
; SUBTRACT CVAL FROM SUM
; FORM 2'S COMPLEMENT THEN ADD
;
SUBTR: LD A,(CVAL)
XOR 0FFH
LD (CVAL),A
LD A,(CVAL+1)
XOR 0FFH
LD (CVAL+1),A
LD A,(CVAL+2)
AND 7FH ;CLR I FLAG
XOR 0FFH
LD (CVAL+2),A
SCF
JP ADD1
;
; PRINT BALANCE/TOTAL
; SEND 2'S COMPLEMENT IF NEGATIVE
;
PRTOT: CALL TPRINT
DEFB ' TOTAL IS ',0
JP TOTAL
PRBAL: CALL TPRINT
DEFB 0DH,0AH,'BALANCE ',0
TOTAL: LD HL,SUM+2
BIT 7,(HL)
JR Z,PBA2 ;NOT NEGATIVE
LD A,'-'
CALL OUTPUT
;
; FORM THE TWO'S COMPLEMENT OF SUM
;
LD A,(SUM+2)
XOR 0FFH
LD (SUM+2),A
LD A,(SUM+1)
XOR 0FFH
LD (SUM+1),A
LD A,(SUM)
XOR 0FFH
ADD A,1
LD (SUM),A
LD A,(SUM+1)
ADC A,0
LD (SUM+1),A
LD A,(SUM+2)
ADC A,0
LD (SUM+2),A
PBA2: LD A,'$'
CALL OUTPUT
;
; NOW MOVE SUM TO BINARY
;
LD B,3 ;MOVE 3 BYTES
LD HL,SUM
LD IX,BINARY
PBA4: LD A,(HL)
LD (IX+0),A
INC HL
INC IX
DJNZ PBA4
CALL BTOD
LD A,1 ; WRITE INTO BUFIN BUT NOT USED
LD DE,BUFIN ;SO PUTBIN KNOWS WHERE TO WRITE
LD (V),A
LD B,1
LD HL,BUFIN
INC HL
CALL PUTBIN
LD A,0
LD (V),A
RET
;
; TRANSFER BAL AT GETCMDNING OF YEAR TO SUM
;
YRSTRT: LD A,(BEGYR)
LD (SUM),A
LD A,(BEGYR+1)
LD (SUM+1),A
LD A,(BEGYR+2)
LD (SUM+2),A
RET
;
; PACK CATEGORY FLAG
;
PAKCAT: LD HL,CAT+15
LD BC,16
CPDR
JP PE,PKC5
CALL PRINT
DEFB 0DH,0AH,'INVALID CATEGORY',0DH,0AH,0
JP GETCMD
PKC5: LD A,C
SLA A
SLA A
SLA A
SLA A
RET
;
; UNPACK ON SCREEN IN PAGE LENGTHS
;
;
; FIND NAME
; RETURN A=NAME INDEX,CARRY=0 IF FOUND
; RETURN A=0,CARRY=1 IF NOT FOUND
;
FINDNA: LD A,(NIND)
FN2: CP 0
JR NZ,FN1
NONAME: LD A,0
SCF
RET
FN1: LD BC,0000H
LD C,A ;BC NOW HAS NIND OFFSET
DEC C
FN7: LD IX,(NB1)
ADD IX,BC
LD A,(IX+0)
LD HL,CMNEM
CP (HL)
JR Z,FN3
JR NZ,FN5 ; NO MATCH
FN3: LD IX,(NB2)
ADD IX,BC
LD A,(IX+0)
LD HL,CMNEM+1
CP (HL)
JR Z,FN4
JR NZ,FN5 ; NO MATCH
FN4: LD IX,(NB3)
ADD IX,BC
LD A,(IX+0)
LD HL,CMNEM+2
CP (HL)
JR Z,FN6 ; FOUND IT
JR NZ,FN5 ; NO MATCH
FN5: DEC C
JP P,FN7
INC C
JP NONAME
FN6: LD A,C ; NAME FOUND
SCF
CCF
RET
;
; GET NAME INDEX EQUIV TO NAME
; RETURN A=0,C=1 IF NOT FOUND
;
NAMBYT: LD DE,0000H
LD A,(INPTR)
LD E,A
LD A,(INNUM)
CP E
JR NC,NBYT4
JR Z,NBYT4
NBYT2: CALL PRINT
DEFB 0DH,0AH,'3 CHARACTER NAME NOT SPECIFIED',0DH,0AH,0
JP GETCMD
NBYT4: LD B,3
LD IY,CMNEM
LD HL,BUFIN
ADD HL,DE
LD A,(HL) ;LOAD C'TH ENTRY IN BUFIN
CP BLANK
JR NZ,NBYT3
LD HL,INPTR
INC (HL)
JR NZ,NAMBYT ; IGNORE LEADING SPC'S
; TRANSFER NAME TO CMNEM
NBYT1: LD A,(INPTR)
INC A
LD (INPTR),A
LD E,A ;INCREMENT INPTR LOCAL VAR.
LD A,(INNUM)
CP E
JR Z,NBYT2 ; ERROR RETURN
NBYT3: LD HL,BUFIN
ADD HL,DE
LD A,(HL)
LD (IY+0),A
INC IY
DJNZ NBYT1
LD A,(INPTR)
INC A
LD (INPTR),A
JP FINDNA ; RETURN
;
; PUT NAME IN NAME FILE
;
FIXNAM: LD A,(NIND)
CP 0FFH
JR NZ,NAMADD
NBFULL: CALL PRINT
DEFB 0DH,0AH,'NAME BUFFER FULL',0DH,0AH,0
JP GETCMD
NAMADD: LD BC,0000H
LD C,A ;C IS NOW INDEX
LD A,(CMNEM)
LD IY,(NB1)
ADD IY,BC
LD (IY+0),A
LD A,(CMNEM+1)
LD IY,(NB2)
ADD IY,BC
LD (IY+0),A
LD A,(CMNEM+2)
LD IY,(NB3)
ADD IY,BC
LD (IY+0),A
LD A,(OFFST)
LD IY,(OL)
ADD IY,BC
LD (IY+0),A
LD A,(OFFST+1)
LD IY,(OH)
ADD IY,BC
LD (IY+0),A
NADD: CALL PRINT
DEFB 0DH,0AH,'TYPE FULL CHECK NAME',0DH,0AH,0
CALL TABOFF
LD A,0
LD (INPTR),A
LD (INNUM),A ; USE BUFIN TO GET NAME
CALL GETIN
; COMPUTE ADR FOR NAME IN NTABLE
OR A ;CLR CARRY
LD HL,(NTABLE)
LD DE,(OFFST)
ADD HL,DE
LD (NPTR),HL
;
;CHECK FOR NAME FILE FULL
;
LD BC,0000H
LD A,(INNUM)
LD C,A
LD HL,(NPTR)
ADD HL,BC
LD (NTEMP),HL
LD HL,(TOP)
LD BC,(NTEMP)
SBC HL,BC
JP C,NBFULL
; TRANSFER NAME FROM BUFIN TO NTABLE
NCONT: LD HL,BUFIN
LD DE,(NPTR)
LD BC,000H
LD A,(INNUM)
LD C,A
LDIR
MOVDON: LD A,EOL ; MARK END OF LINE
LD (DE),A
; UPDATE OFFST
LD A,(INNUM)
INC A
LD (INNUM),A ;TO ACCOUNT FOR EOL
LD B,A
LD A,(OFFST)
ADD A,B
LD (OFFST),A
JR NC,MVD1
LD HL,OFFST+1
INC (HL)
MVD1: LD A,(NIND)
INC A
LD (NIND),A
DEC A
RET
;
; PRINT THE NUMBER OF NAMES IN THE NAME FILE
;
PRTNUM: CALL PRINT
DEFB ' ',0DH,0AH,0H
LD A,(NIND)
LD (BINARY),A
CALL BTOD
LD B,3
LD DE,BUFIN ;PUTBIN WILL WRITE DATA
CALL PUTBIN ;SOMEWHERE SO PUT IT IN BUFIN
CALL PRINT
DEFB ' NAMES IN THE NAME FILE (255 MAX.)',0DH,0AH,0H
LD A,0
LD (INPTR),A
LD (INNUM),A
RET
;
; PRINT NAME MNEUMONIC
; BC CONTAINS INDEX TO NAME FILE
; DE POINTS TO INPUT LOCATION IN BUFIN
;
GETNAM: LD B,0
LD A,BLANK
CALL OUTPUT
LD (DE),A
INC DE
LD HL,(NB1)
ADD HL,BC
LD A,(HL)
CALL OUTPUT
LD (DE),A
INC DE
LD HL,(NB2)
ADD HL,BC
LD A,(HL)
CALL OUTPUT
LD (DE),A
INC DE
LD HL,(NB3)
ADD HL,BC
LD A,(HL)
CALL OUTPUT
LD (DE),A
INC DE
LD A,BLANK
CALL OUTPUT
LD (DE),A
INC DE
CALL OUTPUT
LD (DE),A
INC DE
PUSH DE
POP HL ;PUT DE IN HL
LD BC,BUFIN
OR A
SBC HL,BC
LD A,L
LD (INPTR),A
RET
;
; TAB INPUT ON SPACE
; RETURN TO GETIN IF SPACE
; AFTER TABING TO NEXT FIELD
;
TABNXT: PUSH AF
CP BLANK
JR NZ,TABRET
LD A,(TABFLG)
OR A
JR Z,TABRET
LD BC,0000H
LD A,(INPTR)
LD C,A
LD HL,TABS
ADD HL,BC
LD A,(HL)
OR A
JR NZ,TABRET
; MOVE INPTR FORWARD TO NEXT TAB
; INSERTING SPACES WHILE MOVING
TABMOV: LD IY,BUFIN
LD A,(INPTR)
LD C,A
LD A,BLANK
ADD IY,BC
LD (IY+0),A
CALL OUTPUT
INC C
LD A,C
LD (INPTR),A
LD HL,TABS
ADD HL,BC
LD A,(HL)
OR A
JR Z,TABMOV
LD A,(INNUM)
CP C
JR NC,TBM1
POP AF
TBM1: POP AF
JP GETIN
TABRET: POP AF ; VALID INPUT
RET
;
TABS: DEFB 0,0,0,0,0,0,1,0,0,1
DEFB 0,0,0,1,0,0,0,0,0,0
DEFB 0,1,1,1,0,0,1,0,0,0,0,0,0
;
; TURN TABBING ON AND OFF
;
TABON: LD A,0FFH
LD (TABFLG),A
RET
TABOFF: LD A,0
LD (TABFLG),A
RET
;
; OUTPUT SELECTOR
;
OUTPUT: PUSH AF
LD A,(OUTPOS)
INC A
LD (OUTPOS),A
PUSH HL
LD HL,PTRFLG
BIT 7,(HL)
POP HL
JR Z,CONOU1
POP AF
;
; DO NOT PASS FWDSP ON TO PRINTER
;
CP FWDSP
RET Z
;
PRTOUT: PUSH AF
PUSH BC
PUSH DE
PUSH HL
LD E,A
LD C,5
CALL BDOS
POP HL
POP DE
POP BC
POP AF
RET
CONOU1: POP AF
CONOUT: PUSH AF
PUSH BC
PUSH DE
PUSH HL
LD E,A
LD C,2
CALL BDOS
POP HL
POP DE
POP BC
POP AF
RET
;
; TOGGLE PRINTER ON
;
TOGGLE: LD A,0FFH
LD (PTRFLG),A
JP CMD2
;
; ASSUME VALID FCB HAS BEEN SET UPON ENTRY OR MODIFIED
; BY MOVNAM OR PUTNAM, SAVE CURRENT CHECK FILE ON DISK
;
SAVCHK: LD A,(FCB) ;SEE IF DEFAULT DRIVE
CP 0H
JR NZ,S1 ;IF DRIVE SPECIFIED, IGNORE FOLLOWING
LD A,(DFTUNT) ;ELSE GET THE DEFAULT UNIT
INC A
LD (FCB),A ;AND PUT IT IN FCB
S1: LD DE,FCB ;AMBIGUOUS NOT PERMITTED IN DELETE
LD C,DELFC
CALL BDOS
LD DE,FCB
LD C,MAKEFC
CALL BDOS
INC A
JR NZ,SAVCK1
CALL PRINT
DEFB 0DH,0AH,'UNABLE TO SAVE CHECKS',0DH,0AH,0H
POP AF
JP GETCMD
SAVCK1: LD A,0H
LD (FCB+32),A
CALL BUG3 ;CORRECTS BUG ON 31 ENTRIES
LD BC,(FILSIZ)
ADD HL,BC ;COMPUTES ADR. OF LAST CHECK DATA
LD (CHKEND),HL
LD HL,CKLOC
SLOOP: LD DE,DMA
LD BC,128
LDIR ;FILL BUFFER WITH 128 BYTES
LD DE,FCB
LD C,WRTFC
PUSH HL ;IT GETS DESTROYED OTHERWISE
CALL BDOS ;WRITE IT ON DISK
POP HL
OR A
JR Z,SAVOK
CALL PRINT
DEFB 0DH,0AH,'WRITE ERROR SAVING CHECKS',0DH,0AH,0H
POP AF ;CLEAN UP STACK
JP GETCMD
SAVOK: PUSH HL
LD BC,(CHKEND)
OR A
SBC HL,BC
POP HL
JR C,SLOOP ;LOOP UNTIL HL>CHKEND
LD DE,FCB ;ELSE CLOSE THE FILE & RETURN
LD C,CLSFC
CALL BDOS
RET
;
; SAVE EXISTING NAME FILE ON THE DISK
; ASSUME THAT NFCB HAS BEEN PREVIOUSLY UPDATED
;
SAVNAM: LD A,(NFCB) ;CHECK FOR AMBIGUOUS UNIT NUMBER
CP 0H ;IF NOT AMBIGUOUS THEN IGNORE
JR NZ,S2
LD A,(DFTUNT) ;ELSE GET THE DEFAULT DRIVE NUMBER
INC A
LD (NFCB),A ;AND PUT IT IN NFCB
S2: LD DE,NFCB
LD C,DELFC
CALL BDOS
LD DE,NFCB
LD C,MAKEFC
CALL BDOS
INC A
JR NZ,SAVNA1
CALL PRINT
DEFB 0DH,0AH,'UNABLE TO SAVE NAMES',0DH,0AH,0H
POP AF ;CLEAN UP STACK
JP GETCMD
SAVNA1: LD A,0H
LD (NFCB+32),A
LD HL,NTABL
LD BC,(OFFST)
ADD HL,BC ;COMPUTES END OF NAME FILE
LD (NAMEND),HL
LD HL,NIND ;HL POINTS TO START OF NAMES FILE
NLOOP: LD DE,DMA
LD BC,128
LDIR ;FILLS DMA BUFFER WITH 128 BYTES
LD DE,NFCB
LD C,WRTFC
PUSH HL ;IT GETS DESTROYED
CALL BDOS ;SAVES DMA BUFFER ON DISK
POP HL
OR A
JR Z,NSAVOK
CALL PRINT
DEFB 0DH,0AH,'WRITE ERROR SAVING NAMES',0DH,0AH,0H
POP AF ;CLEAN UP THE STACK
JP GETCMD
NSAVOK: PUSH HL
LD BC,(NAMEND)
OR A
SBC HL,BC
POP HL
JR C,NLOOP ;LOOP UNTIL HL>NAMEND
LD DE,NFCB
LD C,CLSFC ;NOW CLOSE NAME FILE
CALL BDOS
RET
;
;
; LOAD CHECK FILE WHOSE NAME IS IN FCB
; ASSUME NAME IS VALID--SET BY MOVNAM OR PUTNAM
; IF READ IS SUCCESSFUL, THEN CLOSE THE FILE AND
; MAKE THE OLD COPY A BACK UP COPY
;
LDCHK: LD DE,FCB
LD C,OPENFC
CALL BDOS
INC A ;CHECK IF OPEN ERROR
JR NZ,LDC1
CALL PRINT
DEFB 0DH,0AH,'CHECK NAME DOES NOT EXIST',0DH,0AH,0H
POP AF
JP GETCMD
LDC1: LD DE,CKLOC
LD A,0H
LD (FCB+32),A
LDC2: PUSH DE
LD DE,FCB
LD C,READFC
CALL BDOS
POP DE
OR A ;RETURNS NZ IF END OF FILE
JR NZ,CLSCHK
LD HL,DMA
LD BC,128
LDIR
JP LDC2
;
CLSCHK: LD C,CLSFC
LD DE,FCB
CALL BDOS ;CLOSE THE CHECK FILE
RET
;
; LOAD NAME FILE WHOSE NAME IS IN NFCB
; ASSUME NAME IS VALID AND SET BY MOVNAM OR PUTNAM
LDNAM: LD DE,NFCB
LD C,OPENFC
CALL BDOS
INC A ;RETURNS FFH IF SUCCESSFUL
JR NZ,LDN1
CALL PRINT
DEFB 0DH,0AH,'CAN NOT FIND NAME FILE',0DH,0AH,0H
JP GETCMD
LDN1: LD DE,NAMLOC
LD A,0H
LD (NFCB+32),A
LDN2: PUSH DE
LD DE,NFCB
LD C,READFC
CALL BDOS
POP DE
OR A ;RETURNS NZ IF EOF
JR NZ,CLSNAM
LD HL,DMA
LD BC,128
LDIR
JP LDN2
;
CLSNAM: LD C,CLSFC
LD DE,NFCB
CALL BDOS ;CLOSE THE NAME FILE
RET
;
; PRINT/FIX NAME OF CHECK FILE
; TO BE SAVED
;
PRTNAM: CALL PRINT
DEFB 0DH,0AH,'CHECKS AND NAMES TO BE SAVED AS',0DH,0AH,0
LD B,8
LD HL,FCB+1
PRTN1: LD A,(HL)
CALL OUTPUT
INC HL
DJNZ PRTN1
LD A,20H ;SEND A SPACE
CALL OUTPUT
LD B,8
LD HL,NFCB+1
PRTN2: LD A,(HL)
CALL OUTPUT
INC HL
DJNZ PRTN2
CALL PRINT
DEFB 0DH,0AH,'OK? (Y/N)',0
CALL INPUT
PUSH AF
CALL CRLF
POP AF
CP 'Y'
JR NZ,PRN2
RET
PRN2: CP 'N'
JR NZ,PRTNAM
CALL PUTNAM
RET
;
; GET NEW FILENAME
;
PUTNAM: CALL PRINT
DEFB 0DH,0AH,'NAME OF CHECK FILE : ',0DH,0AH,0
CALL GETINP
CALL FXFCB
CALL FXNFCB ;CLEAR THE FILE CONTROL BLOCKS
LD HL,BUFIN
PTN1: LD A,(HL)
INC HL
CP 20H
JR Z,PTN1 ;READ FORWARD TO FIRST CHAR
LD A,(HL) ;IS THE NEXT CHAR A ':'
CP ':'
DEC HL ;RESET HL TO FIRST CHAR
JR NZ,PTN2
CALL MAKFNO ;IF SO MAKE THE DISK NUMBER
LD (FCB),A ;AND PUT IT INTO THE FCB
PTN2: LD DE,BUFIN ;NOW LETS COMPUTE INPTR
PUSH HL
OR A
SBC HL,DE ; HAS VALUE OF INPTR
LD C,L
POP HL
LD DE,FCB+1 ;DE POINTS TO FCB NAME
;
; NOW MOVE THE NAME POINTED TO BY HL TO FCB UNTIL A SPACE
; IS ENCOUNTERED OR UNTIL INPTR EQUALS INNUN
;
PTN3: LD A,(INNUM)
CP C
JP Z,COPYN2 ;IF EQUAL WERE DONE
LD A,(HL)
CP 20H ;IS IT DONE?
JR Z,PTN4
CP '.'
JR Z,PTN5
LD (DE),A ;ELSE MOVE THE CHARACTER
INC DE
INC HL
INC C
JP PTN3
;
PTN5: CALL PRINT
DEFB 0DH,0AH,'DO NOT INCLUDE FILE TYPE',0DH,0AH,0H
JP PUTNAM
;
; CHECK NAME SUCCESSFULLY TRANSFERRED , NOW CHECK FOR NAME FILE
;
PTN4: LD A,(HL)
INC HL
INC C
CP 20H
JR Z,PTN4 ;READ FORWARD TO FIRST NON BLANK CHAR.
LD A,(INNUM)
CP C
JP Z,DONPTN
LD A,(HL) ;IS THE NEXT CHAR A ':'
DEC HL
CP ':'
JR NZ,PTN6 ;IF NOT TRANSFER NAME TO NFCB
CALL MAKFNO
LD (NFCB),A ;PUT DISK NUMBER IN NFCB
PTN6: LD DE,BUFIN
PUSH HL
OR A
SBC HL,DE
LD C,L
POP HL
LD DE,NFCB+1
;
; NOW MOVE THE NAME POINTED TO BY HL TO NFCB UNTIL A SPACE
; IS ENCOUNTERED OR UNTIL INPTR EQUALS INNUN
;
PTN7: LD A,(INNUM)
CP C
JP Z,DONPTN
LD A,(HL)
CP 20H ;NAME DONE IF TRAILING SPACE
JP Z,DONPTN
CP '.'
JP Z,DONPTN ;IGNORE ANY NAME TYPE GIVEN
LD (DE),A ;ELSE MOVE THE CHARACTER
INC DE
INC HL
INC C
JP PTN7
;
; IF ONLY ONE NAME IS GIVEN, THEN ASSUME THAT NAME FILE
; IS THE SAME AS THE CHECK FILE
;
COPYN2: LD HL,FCB
LD DE,NFCB
LD BC,9
LDIR
;
; NOW ALL NAMES HAVE BEEN MOVED, FIX UP THE TYPES AND
; RETURN FROM THIS SUBROUTINE CALL
;
DONPTN: CALL FIXTYP
RET
;
; GET THE DISK UNIT NUMBER AND CONVERT IT TO A BINARY
; NUMBER AND RETURN IT IN THE ACC.
; SET HL TO THE FIRST VALID CHARACTER IN THE NAME
; BEFORE RETURNING
;
MAKFNO: LD A,(HL) ;HL POINTS TO UNIT NUMBER ASCII CHAR
INC HL
INC HL ;LEAVE WITH HL AT NXT CHAR AFTER ':'
SUB 40H
CP 1
RET Z
CP 2
RET Z ;FOR NOW ONLY 2 DRIVES
CALL PRINT
DEFB 0DH,0AH,'INVALID DRIVE SPECIFIED',0DH,0AH,0
POP AF ;CLEAN UP THE STACK
JP PUTNAM ;ASK IT AGAIN
;
; TEXT PRINTER ON SELECTED OUTPUT DEVICE
;
TPRINT: POP HL ;HL POINTS TO TEXT TO BE PRINTED
PRI10: LD A,(HL)
OR A
JR Z,PRI20
CALL OUTPUT
INC HL
JP PRI10
PRI20: INC HL
PUSH HL
RET
;
;
; TEXT PRINTER ON CONSOLE ONLY
;
PRINT: POP HL ;HL POINTS TO TEXT TO BE PRINTED
PR10: LD A,(HL)
OR A
JR Z,PR20
PUSH BC
PUSH DE
PUSH HL
LD C,2
LD E,A
CALL BDOS
POP HL
POP DE
POP BC
INC HL
JP PR10
PR20: INC HL
PUSH HL
RET
;
; CHECK KEYBOARD INPUT--IF CANCEL THEN JUMP TO COMMAND MODE
; ELSE IGNORE THE INPUT AND RETURN----DESTROYS AF
;
KBDTST: PUSH BC ;ADDED ROUTINE IN REV 1.4
PUSH DE
PUSH HL
LD C,11 ;GET CONSOLE STATUS
CALL BDOS
OR A
POP HL
POP DE
POP BC
RET Z
CALL SYSIN ; READ KEYBOARD
CP CANCEL
JP Z,GETCMD
RET
;
;
; PRINT INCOME TAX DEDUCTIBLE CHECKS
;
ITAX: CALL CRLF
LD A,'C'
LD (CMD),A
CALL HEAD
CALL ZSUM
CALL GOTOP
CALL END
ITAX1: CALL GETNXT
JR C,TAXDON
LD HL,CVAL+2
BIT 7,(HL) ;TEST I FLAG
JP Z,ITAX1
LD HL,DAY
BIT 7,(HL)
JR NZ,ITAX1 ;IGNORE DEPOSITS
CALL UNPACK
CALL CRLF
CALL ADD
JP ITAX1
TAXDON: CALL PRTOT
JP GETCMD
;
; PRINT WIFES / RETURNED CHECKS
;
WSRC: LD A,080H
JP RC1
RSRC: LD A,040H
RC1: LD (MASK),A
LD A,'C'
LD (CMD),A
CALL HEAD
CALL CRLF
CALL ZSUM
CALL GOTOP
CALL END
WRLOOP: CALL GETNXT
JP C,WRDONE
LD HL,DAY
BIT 7,(HL) ;IGNORE DEPOSITS
JR NZ,WRLOOP
LD A,(CNUM+1)
LD B,A
LD A,(MASK)
AND B
JR Z,WRLOOP
CALL UNPACK
CALL CRLF
CALL ADD
JP WRLOOP
WRDONE: CALL PRTOT
JP GETCMD
;
;************************************************************
;
; PROGRAM STARTS HERE
;
;************************************************************
;
START1: LD HL,000H
ADD HL,SP
LD (OLDSP),HL
LD SP,STACK+128 ;CREATE LOCAL STACK
XOR A
LD (PTRFLG),A ;START WITH PRINTER OFF
;
; IN ORDER FOR REV 1.4 TO WORK, BIOS LOCATION FOR SYSTEM INPUT
; WILL BE COMPUTED AND STORED IN INPADR FOR INPUT WITHOUT ECHO
;
LD HL,(1) ;GET ADDRESS OF BIOS+3
LD BC,6 ;INPUT ADDRESS IS 6 BYTES HIGHER
ADD HL,BC
LD (INPADR+1),HL ;STORE ADDRESS THERE
;
; NOW PUT NOP'S IN 100-103H SO WARM START CAN BE DONE AT 100H
;
LD A,0 ;NOP INSTRUCTION
LD (100H),A
LD (101H),A
LD (102H),A
;
; SIGN ON MESSAGE
;
LD A,CLRSCR
CALL OUTPUT
CALL PRINT
DEFB 'CHECKING PROGRAM',0DH,0AH
DEFB 'RALPH SHERMAN',0DH,0AH
DEFB '15 HYDAWAY DR',0DH,0AH
DEFB 'FOREST,VA 24551',0DH,0AH
DEFB 'REVISION 1/2/83',0DH,0AH,0H
;
;
; MOVE INITIAL CHECK DATA TO START OF CHECK FILE
;
LD HL,CKTBL
LD DE,CKLOC
LD BC,CKSIZ
LDIR
;
; INITIALIZE NAME FILE
;
LD A,0
LD (NAMLOC),A
LD (NAMLOC+1),A
LD (NAMLOC+2),A
;
; CHECK IF FILE NAME FOR CHECKS IS IN THE FCB
;
LD A,(FCB+1) ;CHECK IF THERE IS A NAME
CP 20H ;IF SPACE THEN NO NAME
JR Z,ST10
;
; NOW THAT A NAME IS PRESENT, LOAD THE CHECK AND NAME FILES
;
CALL MOVNAM ;MOVE NAMES IN FCS
CALL LDCHK
CALL LDNAM
JP GETCMD
;
ST10: CALL PRINT
DEFB 'CHECK FILE IS CLEAR',0DH,0AH,0
JP GETCMD
;
; FXNFCB INITIALIZES THE NAME FILE CONTROL BLOCK
; IT FILLS NFCB WITH 32 ZEROES AND THE FILE NAME WITH SPACES
;
FXNFCB: LD HL,NFCB
LD A,0
LD B,36
FXNF1: LD (HL),A
INC HL
DJNZ FXNF1 ;PUT 0'S IN NFCB
LD HL,NFCB+1
LD A,20H
LD B,11
FXNF2: LD (HL),A
INC HL
DJNZ FXNF2 ;PUT SPACES IN NAME AREA
RET
;
; FXFCB INITIALIZES THE CHECK FILE CONTROL BLOCK
; IT FILLS FCB WITH 32 ZEROES AND THE FILE NAME WITH SPACES
;
FXFCB: LD HL,FCB
LD A,0
LD B,36
FXFC1: LD (HL),A
INC HL
DJNZ FXFC1 ;PUTS 0'S IN FCB
LD HL,FCB+1
LD A,20H
LD B,11
FXFC2: LD (HL),A
INC HL
DJNZ FXFC2 ;PUT SPACES IN NAME AREA
RET
;
; MOVNAM READS THE FCB AND FIXES UP THE FILE TYPES
; IF A FILE IS SPECIFIED FOR THE NAME FILE, IT MOVES FCB2 TO NFCB
;
MOVNAM: LD A,(FCB2+1)
CP 20H ;WAS A NAME FILE SPECIFIED?
JR Z,MOVN4 ;NO NAME, COPY CHECK FILE NAME
CALL FXNFCB
LD HL,FCB2
LD DE,NFCB
LD BC,15
LDIR ;ELSE COPY NAME SPECIFIED
JR FIXTYP
MOVN4: CALL FXNFCB
LD HL,FCB ;NAME FILE IS SAME AS CHK FILE
LD DE,NFCB
LD BC,15
LDIR
;
; FIXTYP SETS THE FILE TYPES FOR THE CHECK AND NAME FILES
;
FIXTYP: LD HL,NAM
LD DE,NFCB+9
LD BC,3
LDIR ;SET .NAM AS NAME FILE TYPE
LD HL,CHK
LD DE,FCB+9
LD BC,3
LDIR ;SET .CHK AS CHECK FILE TYPE
RET
;
;FIX NAME ENTRY
;
NAMFIX: CALL NAMPTR ; PTR IN MASK
NF2: CALL PRINT
DEFB 0DH,0AH,'FIX MNEMONIC (Y/N)',0
CALL INPUT
CP 'N'
JR Z,NF1
CP 'Y'
JR NZ,NF2
NF5: CALL PRINT
DEFB 0DH,0AH,'TYPE NEW MNEMONIC',0DH,0AH,0
CALL GETINP
LD A,(INNUM)
CP 3
JR NC,NF6
CALL PRINT
DEFB CLRSCR,'TYPE 3 CHAR MNEMONIC',0DH,0AH,0
JP NF5
NF6: LD HL,BUFIN
LD BC,0000H
LD A,(MASK)
LD C,A
NF3: LD A,(HL)
CP BLANK
JR NZ,NF4
INC HL
JP NF3
NF4: LD IX,(NB1)
ADD IX,BC
LD (IX+0),A
INC HL
LD A,(HL)
LD IX,(NB2)
ADD IX,BC
LD (IX+0),A
INC HL
LD A,(HL)
LD IX,(NB3)
ADD IX,BC
LD (IX+0),A
NF1: CALL PRINT
DEFB 0DH,0AH,'FIX FULL NAME (Y/N)',0
CALL INPUT
CP 'N'
JR Z,NFRTS
CP 'Y'
JR NZ,NF1
LD BC,0000H
LD A,(MASK)
LD C,A
LD IX,(OL)
ADD IX,BC
LD A,(OFFST)
LD (IX+0),A
LD IX,(OH)
ADD IX,BC
LD A,(OFFST+1)
LD (IX+0),A
CALL NADD
LD A,(NIND)
DEC A
LD (NIND),A
NFRTS: JP GETCMD
;
; PRINT MONTHLY BALANCE SHEET
;
TALPR: CALL GETMO
LD A,(PTRFLG)
OR A
JR Z,TP1
LD A,FORMFD
CALL PRTOUT
TP1: CALL CRLF
CALL CRLF
LD B,25
CALL TABIT
CALL TPRINT
DEFB 'BALANCE SHEET ',0
CALL CRLF
CALL CRLF
;
; COMPUTE BAL AT MONTH START
;
CALL YRSTRT
CALL GOTOP
CALL END
TL1: CALL GETNXT
JR C,TDON1
CALL MTEST
JR Z,TL1
JR C,TL1 ;ONLY ADD UP IF < MONTH TALLIED
LD HL,DAY
BIT 7,(HL)
JR NZ,TL2
CALL SUBTR
JP TL1
TL2: CALL ADD
JP TL1
TDON1: CALL TPRINT
DEFB 'STARTING BALANCE',0
LD B,68
CALL TABIT
CALL BUG2
CALL CRLF
CALL CRLF
CALL TPRINT
DEFB 'DEPOSITS',0
CALL CRLF
CALL CRLF
CALL THEAD
CALL CRLF
CALL GOTOP
CALL END
LD A,80H
LD (MASK),A
TL3: CALL GETNXT
JR C,TL4
CALL MTEST
JR NZ,TL3
LD A,(DAY)
AND 0C0H
LD B,A
LD A,(MASK)
CP B
JR NZ,TL3
LD A,0
LD (OUTPOS),A
CALL PRCHK
LD B,67
CALL TABIT
CALL PRVAL
CALL CRLF
CALL ADD
JP TL3
TL4: CALL CRLF
LD B,70
CALL TABIT
CALL TPRINT
DEFB '----------',0
CALL CRLF
CALL TPRINT
DEFB 'TOTAL ',0
LD B,68
CALL TABIT
CALL TOTAL
CALL SAVVAL
CALL ZSUM
CALL CRLF
CALL TPRINT
DEFB 'WITHDRAWALS',0
CALL CRLF
CALL CRLF
CALL THEAD
CALL CRLF
LD A,040H
LD (MASK),A
TL7: CALL GOTOP
TL5: CALL GETNXT
JR C,TL6
CALL MTEST
JR NZ,TL5
LD A,(DAY)
AND 0C0H
LD B,A
LD A,(MASK)
CP B
JR NZ,TL5
CALL PRCHK
LD B,60
CALL TABIT
CALL PRVAL
CALL CRLF
CALL SUBTR
JP TL5
TL6: LD A,(MASK)
OR A
JR Z,TL8
CALL CRLF
CALL TPRINT
DEFB 'CHECKS',0
CALL CRLF
CALL CRLF
CALL THEAD
CALL CRLF
CALL CRLF
LD A,0
LD (MASK),A
JP TL7
TL8: CALL CRLF
LD B,60
CALL TABIT
CALL TPRINT
DEFB '----------',0
CALL CRLF
CALL TPRINT
DEFB 'TOTAL',0
LD B,59
CALL TABIT
CALL TOTAL
CALL CRLF
CALL CRLF
CALL TPRINT
DEFB 'PERIOD ENDING BALANCE',0
LD B,68
CALL TABIT
LD B,3
LD HL,SUM
LD IX,CVAL
LD IY,STEMP
TL9: LD A,(HL)
LD (IX+0),A
LD A,(IY+0)
LD (HL),A
INC HL
INC IX
INC IY
DJNZ TL9
CALL SUBTR
CALL TOTAL
CALL CRLF
LD A,(PTRFLG)
OR A
JR Z,TP2
LD A,FORMFD
CALL PRTOUT
TP2: LD A,0
LD (PTRFLG),A
RET
;
; TEST CHECK MONTH
;
MTEST: LD A,(OUTMO)
OR A
JR NZ,MT1
RET
MT1: LD A,(MONTH)
AND 0FH
LD B,A
LD A,(OUTMO)
CP B
RET
;
; TAB TO PRINTER POS AT B
;
TABIT: LD A,(OUTPOS)
CP B
JR Z,TABRTS
LD A,BLANK
CALL OUTPUT
JR NZ,TABIT
TABRTS: RET
OUTPOS: DEFB 0
;
; GET MONTH ARG FOR PRNT
; IF MONTH ARE PRESENT, PUT IN OUTMO
; DEFAULT IS MONTH 0
;
GETMO: CALL PRINT
DEFB 13,10,'WHAT MONTH ?',0
CALL GETINP
CALL CRLF
LD B,0H
LD HL,BUFIN
;
; FIXED BUG HERE ON GETMO...BLANK ENTRY (CARRIAGE RETURN) IS 0
;
LD A,(INNUM)
OR A
JR NZ,TAL3
LD A,30H
LD (HL),A
LD A,1H
LD (INNUM),A
NOP
NOP
NOP
NOP
NOP
NOP
NOP
TAL3: LD A,0H
LD (INPTR),A
CALL GETDEC
CALL DTOB
LD A,(BINARY)
AND 0FH
LD (OUTMO),A
RET
;
; PRINT CHECK ENTRY FOR TALLY
; IF TALLY IS ON SCREEN, SLOW THE PROCESS DOWN
; ELSE LET IT RIP.
;
PRCHK: CALL KBDTST ;ADDED REV 1.4
CALL SLOW
LD B,0
LD HL,BUFFER
LD IX,BINARY
LD A,0
LD (INPTR),A
LD A,(HL)
LD (IX+0),A
INC B
INC HL
INC IX
LD A,(HL)
AND 03FH
LD (IX+0),A
LD A,0
INC B
INC HL
INC IX
LD (IX+0),A
CALL BTOD
LD B,4
CALL BUG1
;
;PRINT MONTH
;
LD A,(MONTH)
AND 0FH
LD (BINARY),A
CALL BTOD
LD B,4
CALL PUTBIN
;
;PRINT DAY
;
LD A,(DAY)
AND 03FH
LD (BINARY),A
CALL BTOD
LD B,5
CALL PUTBIN
LD A,BLANK
CALL OUTPUT
CALL OUTPUT
CALL UPFLG
LD B,22
CALL TABIT
LD BC,0000H
LD A,(NAME) ;IS OFFSET TO NAME ADDRESS
LD C,A
CALL PRNAM
RET
;
; PRINT CHECK VALUE
;
PRVAL: LD HL,CVAL ;MOVE 3 BYTES FROM CVAL TO BINARY
LD DE,BINARY
LD BC,03H
LDIR
LD A,(BINARY+2)
AND 07FH
LD (BINARY+2),A
CALL BTOD
LD B,1
LD A,B
LD (V),A
CALL PUTBIN
LD A,0
LD (V),A
RET
;
; SLOW DOWN OUTPUT PRINTING WHEN ON CONSOLE
;
SLOW: LD A,(PTRFLG)
OR A
RET NZ
LD A,50 ;SET UP FOR 50 MS. DELAY
DELAY: LD C,249
DLY1: DEC C
JR NZ,DLY1
DEC A
JR NZ,DELAY
RET
;
THEAD: CALL TPRINT
DEFB ' # MO DA FLG NAME',0
JP CRLF
;
; MOVE 3 BYTES FROM SUM TO STEMP
;
SAVVAL: LD A,(SUM)
LD (STEMP),A
LD A,(SUM+1)
LD (STEMP+1),A
LD A,(SUM+2)
LD (STEMP+2),A
RET
;
; GET FILE NAME
;
FILNAM: RET ;FOR NOW
;
STEMP: DEFS 3
;
; GENERAL PURPOSE SUBROUTINES
;
SYSIN: PUSH BC
PUSH DE
PUSH HL
LD C,1
CALL BDOS
POP HL
POP DE
POP BC
RET
;
; MAP LOWER CASE TO UPPER CASE
;
CASE: CP 60H
JR C,CAS10
AND 07FH
SUB 020H
CAS10: RET
;
; GET AN INPUT WITHOUT ECHO
;
SYSINP: PUSH BC
PUSH DE
PUSH HL
INPADR: CALL CONIN ;BIOS CONSOLE INPUT ADDRESS
; ;COMPUTED DURING START
POP HL
POP DE
POP BC
RET
CONIN EQU INPADR+1 ;DUMMY ADDRESS
;
; VARIABLES
;
CTRLC EQU 3
NEWLIN EQU 13
LINEFD EQU 10
BLANK EQU 32
EOL EQU 0FFH
CPTR: DEFS 2 ; CHECK FILE POINTER
SUM: DEFS 3
ADDER: DEFS 3
X0: DEFS 2 ; X TEMP
BUFFER: DEFS 8 ; CHECK BUFFER
CNUM EQU BUFFER
MONTH EQU CNUM+5
DAY EQU CNUM+6
CVAL EQU CNUM+2
NAME EQU CNUM+7
CREV: DEFB 0
CATMOD: DEFB 00H
NAM3: DEFB 'NAM'
NREV: DEFB 0
CMODE: DEFB 0
CMNEM: DEFS 3 ; CHECK MNEMONIC
TPTR: DEFS 2 ; TEMPORARY POINTER
REMAIN: DEFS 3
BINARY: DEFS 3
BUFIN: DEFS 32
BUFSIZ EQU $-BUFIN
INNUM: DEFS 1
INPTR: DEFS 1
XIND: DEFS 1
CMD: DEFS 1
WIFE: DEFS 1
V: DEFB 0
CKSTRT: DEFW CK
BUFEND: DEFS 2
MASK: DEFS 1
NOFFST: DEFW OFFST
NB1: DEFW MNEU1
NB2: DEFW MNEU2
NB3: DEFW MNEU3
OL: DEFW OFFL
OH: DEFW OFFH
NTABLE: DEFW NTABL
TABFLG: DEFB 0 ;0 EQU OFF FF EQU ON
PTRFLG: DEFB 0
OUTMO: DEFB 0
INPOS: DEFS 1
NPTR: DEFS 2
MODE: DEFB 2
LENGTH: DEFS 2
CHKS: DEFW CFILE
NAMES: DEFW NFILE
NTEMP: DEFS 2
TOP: DEFW CCPBAS
STRING: DEFS 16
;
; NEW VARIABLES AS A RESULT OF Z80 CONVERSION
;
;NEWVAR
;
AUTFLG: DEFB 0 ;AUTO CHECK NUMBER OFF
AUTOCN: DEFS 2 ;STOREAGE FOR CHECK NUMBER
JMPADR: DEFS 2 ;LOCATION FOR JUMP INDIRECT
OLDSP: DEFS 2 ;OLD STACK POINTER
STACK: DEFS 128 ;LOCAL STACK
CHKEND: DEFS 2 ;END ADR. OF CHECK FILE
NAMEND: DEFS 2 ;END ADR. OF NAME FILE
BAK: DEFB 'BAK' ;BAK FILE TYPE
NAM: DEFB 'NAM' ;NAME FILE TYPE
CHK: DEFB 'CHK' ;CHECK FILE TYPE
NFCB: DEFS 36 ;NAME FILE CONTROL BLOCK
CKTBL EQU $
.PHASE CKLOC
BEGYR: DEFB 0,0,0 ; BAL AT YR START
WITHNO: DEFB 1; WITHDRAWAL #
DEPNO: DEFB 1 ; DEPOSIT #
BAL: DEFB 0,0,0 ; PRESENT BAL
FILSIZ: DEFB 0,0 ; SIZE OF CFILE IN BYTES
CK EQU $ ; START OF CHECKS
CKSIZ EQU $-BEGYR ;SIZE OF INITIAL CHECK DATA
.DEPHASE
.PHASE NAMLOC
NIND: DEFB 0
OFFST: DEFB 0,0
MNEU1: DEFS 256
MNEU2: DEFS 256
MNEU3: DEFS 256
OFFL: DEFS 256
OFFH: DEFS 256
NTABL EQU $
.DEPHASE
;
; THIS AREA IS PATCHES FOR BUGS SINCE MICROCORNUCOPIA DISTRIBUTION
;
BUG1: LD DE,BUFIN ;SO PUTBIN KNOWS WHERE TO WRITE
CALL PUTBIN
RET
;
; THIS FIX CORRECTS TALLY WHEN STARTING WITH NEGATIVE BALANCE
;
BUG2: CALL SAVVAL ;SAVE STRTING BALANCE IN CASE NEGATIVE
CALL TOTAL ;THIS CONVERTS NEG TO 2'S COMPLEMENT
LD A,(STEMP) ;NOW GET BACK NEGATIVE BALANCE
LD (SUM),A ;SO WE CAN ADD DEPOSITS TO IT
LD A,(STEMP+1)
LD (SUM+1),A
LD A,(STEMP+2)
LD (SUM+2),A
RET
;
; THIS FIX CORRECTS BUG WHEN SAVING AWAY 31 ENTRIES ON DISK
;
BUG3: LD HL,(CKSTRT)
RET
;
;
END START