.TITLE	BAL	ACCOUNT BALANCE MAINTENANCE PROGRAM
	.IDENT	/V7.19/

;*******************************************************************
;
; ACCOUNT BALANCE MAINTENANCE PROGRAM BAL.TSK (INSTALLED AS ...BAL)
;
;
;	FOR NON-PRIVILEGED USERS, BAL DISPLAYS THE ACCOUNT BALANCE AND
;	EXITS.
;
;	FOR PRIVILEGED USERS, THE FOLLOWING OPTIONS ARE AVAILABLE. THOSE
;	MARKED * ARE ACCGEN-SELECTABLE FEATURES.
;		A	ALTER MONTHLY MONEY ALLOCATION ONLY *
;		B	ALTER DISK BLOCK ALLOCATION *
;		C	CHAIN MEMBER ACCOUNT TO A MASTER ACCOUNT
;		E	DISPLAY ACCOUNT PARAMETERS
;		H	DISPLAY HELP TEXT
;		L	SAME AS E, BUT DEFAULTS TO ALL ACCOUNTS
;			OUTPUT IS WRITTEN TO SY:BALANCE.DMP AND SPOOLED
;		M	CREATE A MASTER ACCOUNT (SEE DOCUMENTATION)
;		N	DELETE MASTER STATUS
;		S	SET *ALL* ACCOUNT PARAMETERS
;			CAN ONLY BE DONE ONCE PER ACCOUNT
;		U	UPDATE ACCOUNT BALANCE
;		X	EXIT FROM BAL
;		?	DISPLAY HELP TEXT
;		CTRL/Z	EXIT FROM BAL (THIS MAY BE USED ANY TIME BAL IS
;			PROMPTING, TO CAUSE THE CURRENT OPTION TO BE
;			CANCELLED AND A CLEAN EXIT TO BE MADE)
;
;	ANY OPTION THAT CAUSES A CHANGE IN THE SYSTEM ACCOUNT
;	FILE RESULTS IN AN INFORMATIONAL RECORD BEING WRITTEN
;	TO THE ACCOUNTING DATA FILE, LB:[0,0]ACCOUNTS.DAT.
;	THE FORMAT OF THE DATA IN THIS FILE IS DESCRIBED IN
;	THE DOCUMENTATION.
;
; VERSION:	V6	MARCH 1980
; VERSION:	V7	APRIL 1981
;
;	STEVE THOMPSON
;	SCHOOL OF CHEMICAL ENGINEERING
;	OLIN HALL
;	CORNELL UNIVERSITY
;	ITHACA NY 14853
;
;	REVISION HISTORY
;	----------------
;
;	SMT731	28-JUL-81	CHANGED MAXIMUM LENGTH OF DESCRIPTIVE
;				TEXT FROM 30. TO 40. CHARACTERS. THIS
;				REQUIRED CHANGES IN FILDF.MAC AND
;				RECSUB.MAC ALSO.
;
;	SMT733	30-JUL-81	REMOVED THE "SUPPORT NOT INCLUDED"
;				MESSAGES AND EXTENDED THE BUFFER USED
;				TO FORMAT THE ACCOUNT BALANCE IN THE
;				CASE WHERE THE "FMTUNI" MODULE IS USED.
;
;	SMT737	10-AUG-81	EXTENDED ONE OF THE OUTPUT BUFFERS SO THAT
;				CERTAIN TYPES OF MESSAGE DON'T GET GARBLED.
;
;	SMT739	12-AUG-81	CHANGED REFERENCES TO $DDEC TO FM.QIO
;
;	SMT748	22-SEP-81	ADDED DISK CHARGE COMMENTARY TO THE OUTPUT
;				OF THE EXAMINE COMMAND IF BLOCK ALLOCATION
;				IS SUPPORTED. ALSO REMOVED FORM FEEDS AND
;				REPLACED THEM BY ".PAGE" DIRECTIVES.
;
;	SMT753	 7 OCT 1981	CHANGED NAMES OF CONDITIONAL ASSEMBLY
;				PARAMETERS; SEE THE FILES MODIFY.TXT AND
;				CONDEF.MAC FOR DETAILS.
;
;	SMT771	13-OCT-81	ADDED MINIMUM DISK CHARGE FEATURE TO DISK
;				CHARGE DISPLAY IN THE "E" COMMAND. SEE
;				BALBLD.CMD FOR MORE DETAILS.
;
;	SMT790	13-NOV-81	ALLOW A "D" IN THE FOURTH POSITION IN THE
;				COMMAND LINE TO MEAN DISPLAY EVEN FOR
;				PRIVILEGED USERS.
;				THIS IMPLEMENTS THE "BALD" COMMAND.
;
;	SMT800	27-JAN-82	FIX BUG IN A/C SEARCH ALGORITHM
;
;	SMT803	 9-MAR-82	SMALL COSMETIC CHNAGES TO OUTPUT FORMAT
;
;	SMT804	16-MAR-82	FIX OUTPUT FORMAT WHEN "UNITS" OPTION IS
;				SELECTED.
;
;	SMT814	12-APR-82	LOWER CASE MESSAGES FOR RSX-11M V4.0
;
;	SMT820	21-APR-82	CHANGED NAME OF TASK FROM MACNT TO BAL;
;				CHANGED NAME OF OUTPUT FILE (L OPTION)
;				FROM MACNT.DMP TO BALANCE.DMP
;
;	SMT821	23-APR-82	CHANGED ENTRY POINT NAMES OF ACCOUNTING
;				SUPPORT ROUTINES (SEE MODIFY.TXT)
;
;	SMT828	27-JUL-82	REPLACE "$GNBLK" BY "GT.NXT"
;
;*******************************************************************

	.MCALL	GTIM$S,QIOW$,WTSE$S,EXIT$S,DIR$,MRKT$
	.MCALL	FINIT$,GLUN$,GTSK$S,PRINT$,PUT$,OPEN$W
	.MCALL	FDBDF$,FDAT$A,FDOP$A,FDRC$A,NMBLK$
	.MCALL	CLOSE$,OPEN$M
	.MCALL	GMCR$

	ACTDF$	<:>,<=>	; DEFINE ADDITIONAL ACCOUNT FILE OFFSETS
	FILDF$		; DEFINE RECORDS FILE OFFSETS

;
; CONSTANTS
;

LUN1	=	1		; TERMINAL LUN
LUN2	=	2		; ACCOUNT FILE LUN
				; LUN3 IS USED BY $RFOPN ETC.
LUN4	=	4		; USED FOR "L" OPTION LISTING

EFN1	=	1		; EVENT FLAG FOR ALL I/O

HT	=	11		; HORIZONTAL TAB
LF	=	12		; LINEFEED
CR	=	15		; CARRIAGE RETURN
SPA	=	40		; SPACE
FF	=	14		; FORMFEED

;
; MACROS
;

	.MACRO	PRINT	MSG,MSGSZ
	MOV	MSG,DPBOUT+Q.IOPL
	MOV	MSGSZ,DPBOUT+Q.IOPL+2
	DIR$	#DPBOUT
	.ENDM

	.MACRO	FUNCT	LENGTH,ADDR
	.WORD	LENGTH
	.WORD	ADDR
	.ENDM

	.MACRO	OPTION	OPT,ADDR
	.WORD	''OPT
	.WORD	ADDR
	.ENDM

;
; TEXT MESSAGES
;

	.NLIST	BEX
	.ENABL	LC

OPTION:	.ASCII	<CR><LF>%* Enter Option (?,A,B,C,E,H,L,M,N,S,U,X OR CTRL/Z): %
OPTSIZ=.-OPTION

	.IF DF	AA$PSW

QPSWD:	.ASCII	<CR><LF>/* Enter Password: /
QPSSZ=.-QPSWD

	.ENDC	; DF AA$PSW

PSWD:	.ASCII	<CR>/Enter Password: /
PSWDSZ=.-PSWD
USER:	.ASCII	<CR><LF>%Enter UIC/password or <ESC> for options: %
USERSZ=.-USER

	.IF DF	AA$UNI

TRANS:	.ASCII	<CR>/Enter amount of transaction (units): /
TRANSZ=.-TRANS

	.IFF

TRANS:	.ASCII	<CR>/Enter amount of transaction ($): /
TRANSZ=.-TRANS

	.ENDC	; DF AA$UNI

MSTR:	.ASCII	<CR>/Enter number of master account: /
MSTRSZ=.-MSTR

	.IF DF	AA$BLK

GTBLOK:	.ASCII	<CR>/Enter Disk Block Allocation: /
GBSIZE=.-GTBLOK

	.ENDC	; DF AA$BLK

ACN:	.ASCII	<CR>/Enter new account number: /
ACNSZ=.-ACN
TEXT:	.ASCII	<CR>/Enter descriptive text (<40 characters): /
TEXTSZ=.-TEXT
INTR1:	.BYTE	FF,LF
INTRO:	.ASCII	<CR><LF>/ ** Account Balance Maintainance Program V7.19 /
TIMLOC:	.ASCII	/XX-XXX-XX 00:00:00/
	.ASCII	/ **/
INTRSZ=.-INTRO
	.ASCII	<HT>/Page /
NPAGE:	.ASCII	/   /
HEADSZ=.-INTR1
H0:
H1:	.ASCII	<CR><LF>/The following options are available: /
H1SZ=.-H1
H2:	.ASCII	<CR><LF><HT>/A -- Alter Monthly Allocation (only)/
H2SZ=.-H2
H3:	.ASCII	<CR><LF><HT>/B -- Alter Block Allocation/
H3SZ=.-H3
H4:	.ASCII	<CR><LF><HT>/C -- Chain or unchain an account/
H4SZ=.-H4
H5:	.ASCII	<CR><LF><HT>/E -- Display accounting parameters for an account/
H5SZ=.-H5
H6:	.ASCII	<CR><LF><HT>/H -- Display this HELP text/
H6SZ=.-H6
H7:	.ASCII	<CR><LF><HT>/L -- List all accounts in BALANCE.DMP and spool output/
H7SZ=.-H7
H8:	.ASCII	<CR><LF><HT>/M -- Create a Master Account/
H8SZ=.-H8
H9:	.ASCII	<CR><LF><HT>/N -- Delete master status/
H9SZ=.-H9
H10:	.ASCII	<CR><LF><HT>/S -- Set all new parameters for an account/
H10SZ=.-H10
H11:	.ASCII	<CR><LF><HT>/U -- Update a single account balance (+ or -)/
H11SZ=.-H11
H12:	.ASCII	<CR><LF><HT>/X -- Exit from BAL/
H12SZ=.-H12
H13:	.ASCII	<CR><LF><HT>/? -- Display this HELP text/
H13SZ=.-H13
H14:	.ASCII	<CR><LF><HT>%CTRL/Z forces a clean exit at any point%
	.BYTE	LF,LF
H14SZ=.-H14
H0SZ=.-H0
MCR:	.ASCII	<LF><CR>/>/
MCRSZ=.-MCR
MSTAT:	.ASCIZ	/ (master)/
XM:	.ASCII	<CR><LF>/BAL -- Operation Complete/<CR><LF>
XMSIZ=.-XM
SYDEV:	.ASCIZ	/ System Device /
ACSTR:	.ASCIZ	/: Account #/
NOSET:	.ASCIZ	/: ** Account not set up **/
CHTXT:	.ASCII	<CR>/Account is chained to account #/
CHTXT1:	.BLKB	6
CHA:	.ASCII	<CR>/BAL -- Chain linkage constructed OK/
CHASZ=.-CHA
UCH:	.ASCII	<CR>/BAL -- Chain linkage undone - account has no money/
UCHSZ=.-UCH
MYES:	.ASCII	<CR>/BAL -- Account now has master status/
MYESSZ=.-MYES
MNO:	.ASCII	<CR>/BAL -- Master status deleted OK/
MNOSZ=.-MNO

	.IF DF	AA$BLK

BLK:	.ASCII	<CR>/Disk Block Allocation: /
BLK1:	.BLKB	50.
CURB:	.ASCIZ	/ Average disk use this period: /
WEEK1:	.ASCIZ	<CR>/Weekly Disk Charge: /
WEEK2:	.ASCIZ	/ (today's usage) /
WEEK3:	.ASCIZ	/ (average usage)/

	.ENDC	; DF AA$BLK

BAL:	.ASCII	<CR>/Current Account Balance: /
BAL1:	.ASCII	/$00000.0000 Units/

	.IF DF	AA$MMA

MMA:	.ASCII	<CR>/Monthly Money Allocation: /
MMA1:	.ASCII	/$00000.0000 Units/

	.ENDC	; DF AA$MMA

	.IF DF	AA$PSW

	MPASS		; DEFINE SECURITY PASSWORD FROM ACCGEN

	.ENDC	; DF AA$PSW

	.DSABL	LC

;
;	FUNCTION TABLE FOR TRANSACTION RECORDING
;	*NOTE* THE ORDER OF THE ENTRIES IS IMPORTANT
;

	.EVEN

FNCTAB:	FUNCT	F.LSET,FNSET
	FUNCT	F.LUPD,FNUPD
	FUNCT	F.LBLK,FNBLK
	FUNCT	F.LMMA,FNMMA
	FUNCT	F.LCHA,FNCHA
	FUNCT	F.LMAS,FNMAS
	FUNCT	F.LDMS,FNDMS

;
; OPTIONS TABLE
;

OPTTAB:	OPTION	A,ALLOC		; ALTER MONTHLY MONEY ALLOCATION OPTION
	OPTION	B,BLOCK		; ALTER BLOCK ALLOCATION OPTION
	OPTION	C,CHAIN		; CHAIN A/C TO MASTER A/C OPTION
	OPTION	E,EXAMN		; DISPLAY A/C PARAMETERS OPTION
	OPTION	H,HELP		; HELP OPTION
	OPTION	L,LIST		; LIST ALL ACCOUNTS OPTION
	OPTION	M,MASTER	; CREATE A MASTER ACCOUNT
	OPTION	N,DELMST	; DELETE MASTER STATUS
	OPTION	S,SET		; SET NEW ACCOUNT OPTION
	OPTION	U,UPDATE	; UPDATE ACCOUNT OPTION
	OPTION	X,EXIT		; EXIT OPTION
	OPTION	?,HELP		; HELP OPTION
	.WORD	0		; END OF OPTION TABLE

;
; ERROR MESSAGES
;

	.IIF DF AA$V40, .ENABL LC

ERR1:	.ASCII	<CR>/BAL -- Syntax error/
ERR1SZ=.-ERR1
ERR2:	.ASCII	<CR>/BAL -- Illegal option/
ERR2SZ=.-ERR2
ERR3:	.ASCII	<CR>/BAL -- Account file open failure/
ERR3SZ=.-ERR3
ERR4:	.ASCII	<CR>/BAL -- Account does not exist, or password is wrong/
ERR4SZ=.-ERR4
ERR5:	.ASCII	<CR>/BAL -- Invalid password/
ERR5SZ=.-ERR5
ERR6:	.ASCII	<CR>/BAL -- Option not included at ACCGEN/
ERR6SZ=.-ERR6
ERR7:	.ASCII	<CR>/BAL -- Invalid operation - account already set up/
ERR7SZ=.-ERR7
ERR8:	.ASCII	<CR>/BAL -- Invalid operation - account is chained/
ERR8SZ=.-ERR8
ERR9:	.ASCII	<CR>/BAL -- Invalid operation - account not set up/
ERR9SZ=.-ERR9
ERR10:	.ASCII	<CR>/BAL -- Account already has master status/
ERR10SZ=.-ERR10
ERR11:	.ASCII	<CR>/BAL -- Account number already in use/
ERR11S=.-ERR11
ERR12:	.ASCII	<CR>/BAL -- Account has master status - cannot be chained/
ERR12S=.-ERR12
ERR13:	.ASCII	<CR>/BAL -- Cannot find master account/
ERR13S=.-ERR13
ERR14:	.ASCII	<CR>/BAL -- Specified master does not have master status/
ERR14S=.-ERR14
ERR15:	.ASCII	<CR>/BAL -- *WARNING* cannot relocate account/
ERR15S=.-ERR15
ERR16:	.ASCII	<CR>/BAL -- Unable to record this transaction - FCS /
ERR16A:	.BLKB	6
ERR17:	.ASCII	<CR>/BAL -- Unable to create listing file/
ERR17S=.-ERR17
ERR18:	.ASCII	<CR>/BAL -- Cannot unchain - account is not chained/
ERR18S=.-ERR18
ERR19:	.ASCII	<CR>/BAL -- Specified master has chained account(s)/
ERR19S=.-ERR19

	.EVEN

GMCR:	GMCR$			; GET COMMAND LINE BUFFER
BUF	=	GMCR+2		; BUFFER FOR TERMINAL I/O
	.BLKB	<132.-80.>	; (132. BYTES LONG)
				; *NOTE* BUF MUST START ON A WORD BOUNDARY
				; *NOTE* AND MUST BE AT LEAST 128. BYTES
				; *NOTE* LONG BECAUSE OF ITS USE AS A
				; *NOTE* TEMPORARY ACCOUNT BUFFER IN THE
				; *NOTE* "CHAIN" ROUTINE.
OPTEXT:	.BLKB	F.LTXT		; "S" AND "U" OPTION TEXT
GRP:	.WORD	0		; TEMPORARY STORAGE FOR GROUP CODE
MEM:	.WORD	0		; TEMPORARY STORAGE FOR MEMBER CODE
	.BLKB	4.		; [G,M] FORMATTER WORKSPACE (MUST BE NEXT TO 'UIC')
UIC:	.ASCII	/000000/	; USER IDENTIFICATION CODE AREA
ACNO:	.WORD	0		; ACCOUNT NUMBER
CHWD:	.WORD	0		; ACCOUNT CHAIN WORD
ENTRY:	.WORD	0		; ACCOUNT ENTRY ADDRESS
CASH:	.WORD	0,0		; AMOUNT OF TRANSACTION
BLOCKS:	.WORD	0		; DISK BLOCK ALLOCATION
	.WORD	$DFBLK		; (2 WORDS)

	.IF DF	AA$BLK

DSKCHG:	.WORD	0,0		; BUFFER FOR DISK CHARGE CALCULATION
DSKBLK:	.WORD	$DSK1		; DISK CHARGE BUFFER FOR ML.DV
	.WORD	$DSK2		;
ELAPS:	.WORD	<24.*60.*7.>	; MINUTES PER WEEK

	.ENDC	; DF AA$BLK

FCODE:	.WORD	0		; FUNCTION CODE FOR RECORDING
PAGE:	.WORD	0		; LISTING PAGE COUNTER
NUSERP:	.WORD	0		; NUMBER OF ENTRIES ON CURRENT PAGE
NEGFLG:	.WORD	0		; ACCOUNT BALANCE SIGN FLAG
ESCAPE:	.WORD	0		; ESCAPE RECOGNITION FLAG
LUNBUF:	.BLKW	6		; GLUN$ INFORMATION BUFFER
TIMBUF:	.BLKW	8.		; BUFFER FOR GET TIME INFORMATION CALL
				; 0=NO 1=YES
TSKBUF:	.BLKW	16.		; BUFFER FOR GTSK$S INFORMATION
PSWBUF:	.ASCII	/      /	; PASSWORD BUFFER

;
;	DATA STRUCTURES FOR LISTING FILE SY:[UIC]BALANCE.DMP
;

DEFSIZ	=	-5	; INITIAL SIZE OF BALANCE.DMP
EXTSIZ	=	-1	; EXTENSION SIZE
			; (FILE IS NONCONTIGUOUS)

FDB:	FDBDF$
	FDAT$A	R.VAR,FD.CR,,DEFSIZ,EXTSIZ
	FDRC$A	,BUF,132.
	FDOP$A	LUN4,,DMPBLK,FO.WRT

DMPBLK:	NMBLK$	BALANCE,DMP,,SY,0	; DEFAULT FILE IS SY:[UIC]BALANCE.DMP

;
; DIRECTIVE PARAMETER BLOCKS
;

DPBINP:	QIOW$	IO.RVB,LUN1,EFN1,,IOSB,,<BUF,0>	; INPUT DPB
DPBATT:	QIOW$	IO.ATT,LUN1,EFN1
DPBDET:	QIOW$	IO.DET,LUN1,EFN1
DPBOUT:	QIOW$	IO.WVB,LUN1,EFN1,,,,<BUF,0,40>	; OUTPUT DPB
IOSB:	.BLKW	2		; I/O STATUS BLOCK

MKT:	MRKT$	1,1,2		; WAIT FOR ONE SECOND
MKT30:	MRKT$	1,<K$$TPS/2>,1	; WAIT FOR HALF A SECOND
GLUN:	GLUN$	LUN1,LUNBUF	; GET LUN INFO. DPB
	.PAGE
	.SBTTL	MAIN LINE CODE


$MNTEP:				; XFR ADDRESS
	FINIT$			; INITIALISE FSR
	DIR$	#GMCR		; GET COMMAND LINE
	BCC	1002$		; IF CC THERE WAS ONE	
	DIR$	#MKT30		; LET MCR PRINT PROMPT
	BCS	1003$		; JUST IN CASE
	WTSE$S	#1		;
1001$:	BR	1003$		;
1002$:	CMPB	BUF+3,#'D	; FOURTH LETTER OF COMMAND A "D"?
	BEQ	1005$		; IF EQ YES, JUST DISPLAY BALANCE
1003$:				; REF. LABEL

;
; EXECUTE NON-PRIVILEGED FUNCTION IF WE ARE NOT PRIVILEGED
;

	DIR$	#GLUN		; GET LUN INFORMATION (TI:)
	BCS	11$		; JUST IN CASE
	BIT	#U2.PRV,LUNBUF+G.LUCW+2 ; ARE WE PRIVILEGED?
	BNE	2$		; IF NE YES
1005$:	CALL	NONPRV		; EXECUTE NON-PRIVILEGED FUNCTION
11$:	EXIT$S			; AND EXIT
2$:				; REF. LABEL

;
; WRITE OUT INTRODUCTORY  MESSAGE
;

	MOV	#TIMBUF,R1	; GET ADDRESS OF TIME PARAMETERS BUFFER
	GTIM$S	R1		; FIND OUT THE TIME
	MOV	#TIMLOC,R0	; GET BUFFER ADDRESS FOR FORMATTED TIME
	CALL	$DAT		; INSERT THE DATE (DD-MMM-YY)
	MOVB	#SPA,(R0)+	; INSERT A SPACE
	MOV	#3,R2		; SET TIME FORMAT (HH:MM:SS)
	CALL	$TIM		; INSERT THE TIME
	PRINT	#INTRO,#INTRSZ	; TYPE OUT INTRODUCTORY MESSSAGE

;
;	READ THE SECURITY PASSWORD AND CHECK FOR VALIDITY (ACCGEN OPTION)
;

	.IF DF	AA$PSW

	MOV	#DPBOUT,R4	; GET OUTPUT DPB ADDRESS
	MOV	#'$,Q.IOPL+4(R4)  ; SET PROMPT MODE
	PRINT	#QPSWD,#QPSSZ	; PROMPT FOR THE PASSWORD
	CALL	IORNE		; GET THE PASSWORD
	MOV	#PASS,R1	; GET ADDRESS OF RIGHT PASSWORD
	MOV	#PASSZ,R2	; AND ITS SIZE
5$:	CMPB	(R0)+,(R1)+	; DOES IT MATCH?
	BNE	6$		; NO IS ERROR
	DEC	R2		; ANY MORE TO SCAN?
	BNE	5$		; YES
	BR	GETOPT		; PASSWORD OK - CONTINUE
6$:	PRINT	#ERR5,#ERR5SZ	; ILLEGAL PASSWORD
	BR	11$		; SO EXIT

	.ENDC	; DF AA$PSW

;
; READ IN OPTION FROM TERMINAL (PRIVILEGED USERS ONLY)
;

GETOPT:
	MOV	#DPBOUT,R4	; GET OUTPUT DPB ADDRESS
	MOV	#'$,Q.IOPL+4(R4) ; SET TO PROMPT MODE
	PRINT	#OPTION,#OPTSIZ	; PRINT REQUEST FOR OPTION
	CALL	IORVB		; READ OPTION
	CALL	GT.NXT		; GET NEXT NON-BLANK CHARACTER
	BCC	40$		; OK, NOT EOL
	PRINT	#ERR1,#ERR1SZ	; WRITE OUT ERROR MESSAGE
	BR	GETOPT		; AND TRY AGAIN
40$:	CALL	LCASE		; CONVERT TO UPPER CASE

;
;	DETERMINE WHICH OPTION HAS BEEN SELECTED AND EXECUTE THE
;	OPTION SERVICE ROUTINE.
;

	BIC	#177400,R2	; CLEAR EXCESS BITS
	MOV	#OPTTAB,R0	; GET ADDRESS OF OPTION TABLE
50$:	MOV	(R0)+,R1	; GET NEXT OPTION LETTER
	BEQ	70$		; IF EQ, END OF TABLE (ILLEGAL OPTION)
	CMP	R1,R2		; THIS OPTION?
	BEQ	60$		; IF EQ YES
	TST	(R0)+		; NO, POINT TO NEXT TABLE ENTRY
	BR	50$		; AND LOOP
60$:	CALL	@(R0)		; CALL OPTION SERVICE ROUTINE
	BR	GETOPT		; AND GET THE NEXT OPTION
70$:	PRINT	#ERR2,#ERR2SZ	; NOTIFY USER OF ILLEGAL OPTION
GOPT:	BR	GETOPT		; AND TRY AGAIN
	.PAGE
	.SBTTL	HELP OPTION ROUTINE
;+
;
;	THIS ROUTINE PRINTS THE HELP TEXT AT THE TERMINAL FOR THE "H"
;	AND "?" OPTIONS.
;
;	NO REGISTERS ARE USED.
;
;-

HELP:				;

	.IF DF	T$$CPW

	PRINT	#H0,#H0SZ	; TYPE OUT HELP MESSAGE

	.IFF

	PRINT	#H1,#H1SZ	; PRINT OUT HELP MESSAGES
	PRINT	#H2,#H2SZ	;
	PRINT	#H3,#H3SZ	;
	PRINT	#H4,#H4SZ	;
	PRINT	#H5,#H5SZ	;
	PRINT	#H6,#H6SZ	;
	PRINT	#H7,#H7SZ	;
	PRINT	#H8,#H8SZ	;
	PRINT	#H9,#H9SZ	;
	PRINT	#H10,#H10SZ	;
	PRINT	#H11,#H11SZ	;
	PRINT	#H12,#H12SZ	;
	PRINT	#H13,#H13SZ	;
	PRINT	#H14,#H14SZ	;

	.ENDC	; DF T$$CPW

	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	NON-PRIVILEGED USER DISPLAY ROUTINE
;+
; *** NONPRV
;
;	THIS ROUTINE IS CALLED FROM A NON-PRIVILEGED TERMINAL. THE
;	CURRENT UIC IS DETERMINED, THE PASSWORD IS PROMPTED FOR,
;	AND THE ACCOUNT BALANCE IS DISPLAYED.
;
;-

NONPRV:	MOV	#'$,DPBOUT+Q.IOPL+4 ; SET RIGHT CARRIAGE CONTROL FOR PROMPT
	PRINT	#PSWD,#PSWDSZ	; PROMPT FOR THE PASSWORD
	MOV	#SPA,DPBOUT+Q.IOPL+4 ; RESET CARRIAGE CONTROL
	CLRB	PSWBUF		; ASSUME NO PASSOWRD SPECIFIED
	CALL	IORNE		; READ THE PASSWORD
	TST	IOSB+2		; ANY CHARACTERS TYPED?
	BEQ	20$		; IF EQ NO, PASSWORD NOT SPECIFIED
	MOV	#PSWBUF,R1	; GET PLACE TO STUFF PASSWORD
	MOV	#7,R3		; AND THE MAX. LENGTH OF IT
	MOV	#BUF,R0		; SET UP BUFFER ADDRESS
10$:	CMPB	(R0),#CR	; END OF PASSWORD?
	BEQ	20$		; IF EQ YES
	DEC	R3		; NO, CAN WE GET ANY MORE?
	BEQ	40$		; IF EQ, PASSWORD IS TOO LONG
	MOVB	(R0)+,R2	; GET TYPED CHARACTER
	CALL	LCASE		; MAKE SURE IT IS UPPER CASE
	MOVB	R2,(R1)+	; SAVE IT IN PASSWORD BUFFER
	BR	10$		; GO FOR MORE
20$:	GTSK$S	#TSKBUF		; GET TASK PARAMETERS (WE NEED UIC)
	MOVB	TSKBUF+G.TSPC,R1 ; GET MEMBER CODE
	BIC	#177400,R1	; ZERO THE RUBBISH BYTE
	MOV	#UIC,R0		; GET BUFFER ADDRESS FOR ASCII UIC
	MOV	PC,R2		; INCLUDE LEADING ZEROES
	CALL	$CBOMG		; CONVERT TO ASCII
	MOVB	TSKBUF+G.TSGC,R1 ; GET GROUP CODE
	BIC	#177400,R1	; ZERO THE HIGH BYTE
	MOV	#UIC-3,R0	; SET BUFFER ADDRESS
	CALL	$CBOMG		; CONVERT TO ASCII OCTAL
	CALL	OPENAF		; OPEN ACCOUNT FILE
	CALL	ACCNT		; LOOK FOR THE ACCOUNT
	BCS	30$		; IF CS, ACCOUNT NOT FOUND
	MOV	A.CHWD(R0),ACNO	; IS THE ACCOUNT CHAINED?
	BNE	24$		; IF NE YES
	CALL	$AFCLS		; NO, CLOSE ACCOUNT FILE
	CALL	DSPLAY		; THEN DISPLAY PARAMETERS
	BR	29$		; RETURN TO CALLER
24$:	CALL	DSPLAY		; DISPLAY THIS ONE
	MOV	#ACCPT2,$ASUBR	; SET ACCEPTANCE ROUTINE ADDRESS FOR MASTER A/C
	CALL	$ASCAN		; LOCATE THE MASTER ACCOUNT
	BCC	27$		; IF CC OK
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#ERR13,#ERR13S	; PRINT MASTER NOT FOUND MESSAGE
	BR	30$		;
27$:	MOV	R0,ENTRY	; SAVE ENTRY ADDRESS
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	CALL	DSPLAY		; DISPLAY MASTER ACCOUNT PARAMETERS
29$:	PRINT	#MCR,#MCRSZ	; PRINT MCR PROMPT
30$:	RETURN			; RETURN TO CALLER
40$:	PRINT	#ERR1,#ERR1SZ	; TELL USER OF SYNTAX ERROR
	RETURN			; AND RETURN TO CALLER
	.PAGE
	.SBTTL	EXAMINE OPTION ROUTINE
;+
;
;	THIS ROUTINE PRINTS THE ACCOUNTING PARAMETERS FOR THE "E" OPTION.
;	THE USER IS REQUESTED TO TYPE IN THE REQUIRED UIC/PASSWORD
;	COMBINATION.
;	IF THE ACCOUNT IS CHAINED TO A MASTER ACCOUNT, THE PARAMETERS OF
;	THE MASTER ACCOUNT ARE PRINTED ALSO.
;
;-

EXAMN:	CALL	GETUIC		; READ UIC FROM TERMINAL
	TST	ESCAPE		; END OF THIS OPTION?
	BNE	10$		; IF NE YES
	CALL	OPENAF		; OPEN ACCOUNT FILE
	CALL	ACCNT		; FIND ACCOUNT IN FILE
	BCS	EXAMN		; IF CS TRY FOR ANOTHER
	MOV	A.CHWD(R0),ACNO	; IS THE ACCOUNT CHAINED?
	BNE	5$		; IF NE YES
	CALL	$AFCLS		; NO, CLOSE ACCOUNT FILE
	CALL	DSPLAY		; THEN DISPLAY PARAMETERS
	BR	EXAMN		; AND THEN GET NEXT A/C TO EXAMINE
5$:	CALL	DSPLAY		; DISPLAY THIS ONE
	MOV	#ACCPT2,$ASUBR	; SET ACCEPTANCE ROUTINE ADDRESS FOR MASTER A/C
	CALL	$ASCAN		; LOCATE THE MASTER ACCOUNT
	BCC	6$		; IF CC OK
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#ERR13,#ERR13S	; PRINT MASTER NOT FOUND MESSAGE
	BR	EXAMN		;
6$:	MOV	R0,ENTRY	; SAVE THE ENTRY ADDRESS
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	CALL	DSPLAY		; DISPLAY MASTER ACCOUNT PARAMETERS
	BR	EXAMN		; AND LOOP
10$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	SET OPTION ROUTINE
;+
;
;	THIS ROUTINE EXECUTES THE "S" OR SET OPTION. THE FOLLOWING
;	DATA IS REQUESTED FROM THE USER:
;	(1) UIC/PASSWORD COMBINATION
;	(2) ACCOUNT NUMBER TO ASSIGN TO THE ACCOUNT. THIS MUST NOT BE
;	    THE SAME AS THE NUMBER OF ANY OTHER ACCOUNT IN THE ACCOUNT
;	    FILE (A CHECK IS MADE).
;	(3) THE NEW ACCOUNT BALANCE.
;	(4) AN ALLOCATION OF DISK BLOCKS, IF APPLICABLE.
;	THE MONTHLY MONEY ALLOCATION IS SET EQUAL TO THE NEW ACCOUNT
;	BALANCE.
;	ONCE AN ACCOUNT HAS BEEN INITIALISED BY THE SET OPTION, IT CANNOT
;	BE REPROCESSED BY THIS OPTION.
;
;-

SET:	CALL	GETUIC		; GET UIC AND PASSWORD
	TST	ESCAPE		; END OF THIS OPTION?
	BNE	10$		; IF NE YES
	CALL	GETACN		; GET NEW ACCOUNT NUMBER

	.IF DF	AA$BLK

	CALL	GETBLK		; GET BLOCK ALLOCATION

	.ENDC	; DF AA$BLK

	CALL	GETTRN		; GET MONEY AMOUNT
	CALL	OPTXT		; READ IN DESCRIPTIVE TEXT
	CALL	OPENAF		; OPEN ACCOUNT FILE
	MOV	#ACCPT2,$ASUBR	; SET ACCEPTANCE ROUTINE ADDRESS FOR
				; ACCOUNT NUMBER CHECK
	CALL	$ASCAN		; ACCOUNT NUMBER ALREADY IN USE?
	BCS	2$		; IF CS NO, THIS IS GOOD
	CALL	$AFCLS		; MAKE SURE A/C FILE IS CLOSED
	PRINT	#ERR11,#ERR11S	; PRINT ERROR MESSAGE
	BR	SET		; AND TRY AGAIN
2$:	CALL	ACCNT		; LOCATE ACCOUNT
	BCS	SET		; ACCOUNT NOT FOUND
	TST	A.ACNO(R0)	; HAS ACCOUNT ALREADY BEEN PROCESSED?
	BEQ	5$		; IF EQ NO, OK TO CONTINUE
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR7,#ERR7SZ	; SEND OUT ERROR MESSAGE
	BR	SET		; AND TRY AGAIN
5$:	MOV	ACNO,A.ACNO(R0)	; SET UP THE NEW ACCOUNT NUMBER
	CLR	A.CHWD(R0)	; MAKE SURE IT'S NOT CHAINED YET
	CLR	CHWD		;
	MOV	BLOCKS,A.BALL(R0) ; SET BLOCK ALLOCATION
	MOV	BLOCKS+2,A.BALL+2(R0) ;
	MOV	CASH,A.CASH(R0)	; SET HIGH ORDER BALANCE
	MOV	CASH+2,A.CASH+2(R0)	; AND LOW ORDER BALANCE
	MOV	CASH,A.MALL(R0)	; CHANGE HIGH ALLOCATION
	MOV	CASH+2,A.MALL+2(R0) ; AND LOW ALLOCATION
	CALL	$AFPUT		; RE-WRITE THE ACCOUNT
	CALL	$AFCLS		; AND CLOSE THE ACCOUNT FILE
	CALL	DSPLAY		; DISPLAY NEW PARAMETERS
	MOV	#FF.SET,FCODE	; SET TYPE OF TRANSACTION
	CALL	RECORD		; RECORD IT IN ACCOUNTS.DAT
	BR	SET		; GET NEXT UIC TO SET
10$:	RETURN			; AND RETURN TO CALLER
	.PAGE
	.SBTTL	UPDATE OPTION ROUTINE
;+
;
;	THIS ROUTINE PROCESSES THE "U" OR UPDATE OPTION. THE CURRENT
;	ACCOUNT BALANCE OF THE REQUESTED ACCOUNT IS INCREMENTED OR
;	DECREMENTED AS REQUIRED. IT IS ALLOWED FOR THE BALANCE TO
;	BE REDUCED BELOW ZERO BY THIS ROUTINE.
;
;-

UPDATE:	CALL	GETUIC		; GET UIC AND PASSWORD
	TST	ESCAPE		; END OF THIS OPTION?
	BNE	10$		; IF NE YES
	CALL	GETTRN		; GET MONEY AMOUNT
	CALL	OPTXT		; READ IN DESCRIPTIVE TEXT
	CALL	OPENAF		; OPEN A/C FILE
	CALL	ACCNT		; LOOK FOR THE ACCOUNT
	BCS	UPDATE		; ACCOUNT NOT FOUND
	MOV	A.ACNO(R0),ACNO	; ACCOUNT SET UP?
	BNE	5$		; IF NE YES, CONTINUE
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR9,#ERR9SZ	; ISSUE INVALID OPERATION MESSAGE
	BR	UPDATE		; AND TRY AGAIN
5$:	CALL	CHWCHK		; IS THIS ACCOUNT CHAINED?
	BCS	UPDATE		; IF CS YES, MSG. WILL HAVE BEEN ISSUED
	MOV	#CASH+2,R1	; POINT TO LOW ORDER PART OF UPDATE
	ADD	(R1),A.CASH+2(R0) ; ADD IN UPDATE
	ADC	A.CASH(R0)	;
	ADD	-(R1),A.CASH(R0)	;
	CALL	$AFPUT		; RE-WRITE THE ACCOUNT
	CALL	$AFCLS		; AND CLOSE THE ACCOUNT FILE
	CALL	DSPLAY		; DISPLAY NEW PARAMETERS
	MOV	#FF.UPD,FCODE	; SET TRANSACTION TYPE
	CALL	RECORD		; LOG IT IN DATA FILE
	BR	UPDATE		; GET NEXT A/C TO UPDATE
10$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	LIST OPTION ROUTINE
;+
;
;	THIS ROUTINE PROCESSES THE "L" OR LIST OPTION. A FILE CALLED
;	BALANCE.DMP IS CREATED ON SY: UNDER THE CURRENT UIC AND IS
;	SPOOLED TO THE LINEPRINTER IF AVAILABLE. THIS FILE WILL
;	CONTAINED A SUMMARY OF THOSE ACCOUNTING PARAMETERS MAINTAINED
;	BY THE ACCOUNTING PACKAGE IN THE SYSTEM ACCOUNT FILE.
;
;-

LIST:	OPEN$W	#FDB		; CREATE THE LISTING FILE
	BCC	2$		; IF CC OK
	PRINT	#ERR17,#ERR17S	; TELL USER OF CREATE ERROR
	RETURN			; AND RETURN TO CALLER
2$:	CLR	PAGE		; INITIALISE PAGE COUNTER
	CALL	50$		; PRINT A TITLE ON PAGE #1
	CALL	OPENAF		; OPEN THE ACCOUNT FILE
5$:	CALL	$AFGET		; READ SOME DATA FROM THE ACCOUNT FILE
	BEQ	25$		; IF EQ, NO WORDS READ
10$:	TST	NUSERP		; TIME TO PRINT TITLE?
	BGT	15$		; IF GT NO
	CALL	50$		; OK, PRINT PAGE HEADER
15$:	MOV	R0,ENTRY	; STORE ACCOUNT ADDRESS
	CMPB	A.GRP(R0),#'0	; VALID UIC?
	BMI	20$		; IF MI NO
	CMPB	A.GRP(R0),#'3	; MAYBE
	BHI	20$		; IF HI NO
	MOV	R2,-(SP)	; SAVE R2
	CALL	ACDUMP		; DISPLAY THIS ACCOUNT
	DEC	NUSERP		; SHOW ONE MORE ENTRY FOR THIS PAGE
	MOV	(SP)+,R2	; RESTORE R2
	MOV	ENTRY,R0	; RESTORE CURRENT ENTRY ADDRESS
20$:	ADD	#A.LEN,R0	; POINT TO NEXT ENTRY
	SUB	#A.LEN,R2	; COMPUTE HOW MANY WORDS LEFT IN BUFFER
	BHI	10$		; GO AGAIN IF MORE LEFT
25$:	CMPB	#IE.EOF,$AFIOS	; END OF FILE?
	BEQ	30$		; IF EQ YES
	TSTB	$AFIOS		; ANY ERRORS
	BMI	30$		; IF MI YES
	CALL	$AFNXB		; POINT TO NEXT A/C FILE BLOCK
	BR	5$		; READ IN NEXT BLOCK
30$:	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT$	#FDB		; SPOOL OUTPUT FILE FOR PRINTING
	RETURN			;
50$:	MOV	#12.,NUSERP	; INITIALISE NO. USERS PER PAGE
	INC	PAGE		; INCREMENT PAGE NUMBER
	MOV	PAGE,R1		; FORMAT PAGE NUMBER IN PAGE HEADER
	MOV	R0,-(SP)	; SAVE R0
	MOV	R2,-(SP)	; SAVE R2 (DE.CML CHANGES IT)
	MOV	#NPAGE,R0	;
	CALL	DE.CML		;
	PUT$	#FDB,#INTR1,#HEADSZ ; WRITE TITLE ON DUMP
	MOV	(SP)+,R2	; RESTORE R2
	MOV	(SP)+,R0	; RESTORE R0
	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	BLOCK UPDATE OPTION ROUTINE
;+
;
;	THIS ROUTINE PROCESSES THE "B" OR BLOCK UPDATE OPTION. THE
;	ALLOCATION OF DISK BLOCKS FOR THE REQUESTED ACCOUNT IS
;	REPLACED (NOT INCREMENTED OR DECREMENTED) BY THE AMOUNT
;	SPECIFIED. THIS OPTION IS ONLY VALID IF BLOCK ALLOCATION
;	SUPPORT IS INCLUDED IN THE ACCOUNTING PACKAGE AT ACCGEN.
;
;-

BLOCK:

	.IF DF	AA$BLK

	CALL	GETUIC		; GET UIC AND PASSWORD
	TST	ESCAPE		; END OF THIS OPTION?
	BNE	10$		; IF NE YES
	CALL	GETBLK		; GET BLOCK AMOUNT
	CALL	OPENAF		; OPEN A/C FILE
	CALL	ACCNT		; LOCATE ACCOUNT
	BCS	BLOCK		; ACCOUNT NOT FOUND, TRY FOR ANOTHER
	MOV	A.ACNO(R0),ACNO	; ACCOUNT SET UP?
	BNE	5$		; IF NE YES, CONTINUE
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR9,#ERR9SZ	; ISSUE INVALID OPERATION MESSAGE
	BR	BLOCK		; AND TRY AGAIN
5$:	CALL	CHWCHK		; ARE WE A CHAINED ACCOUNT?
	BCS	BLOCK		; IF CS YES, OPTION NOT ALLOWED
	MOV	BLOCKS,A.BALL(R0) ; SET NEW ALLOCATION
	MOV	BLOCKS+2,A.BALL+2(R0) ;
	CALL	$AFPUT		; RE-WRITE THE ACCOUNT
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	CALL	DSPLAY		; DISPLAY NEW PARAMETERS
	MOV	#FF.BLK,FCODE	; SET TRANSACTION TYPE
	CALL	RECORD		; AND LOG IT
	BR	BLOCK		; GET NEXT A/C TO UPDATE

	.IFF

	PRINT	#ERR6,#ERR6SZ	; OPTION NOT SUPPORTED

	.ENDC	; DF AA$BLK

10$:	RETURN			;
	.PAGE
	.SBTTL	ALTER MONTHLY ALLOCATION OPTION
;+
;
;	THIS ROUTINE PROCESSES THE "A" OR MONTHLY ALLOCATION OPTION.
;	IF SUPPORT FOR THIS FEATURE IS INCLUDED AT ACCGEN, THE
;	MONTHLY MONEY ALLOCATION FOR THE SPECIFIED ACCOUNT IS REPLACED
;	BY THE AMOUNT SPECIFIED IN THE COMMAND INPUT, PROVIDED THAT
;	THE ACCOUNT IS NOT CHAINED ELSEWHERE.
;
;-

ALLOC:				;

	.IF DF	AA$MMA

	CALL	GETUIC		; GET UIC
	TST	ESCAPE		; END OF THIS OPTION?
	BNE	10$		; IF NE YES
	CALL	GETTRN		; GET AMOUNT OF MONEY
	CALL	OPENAF		; OPEN ACCOUNT FILE
	CALL	ACCNT		; LOCATE ACCOUNT ENTRY
	BCS	ALLOC		; ACCOUNT NOT FOUND
	MOV	A.ACNO(R0),ACNO	; ACCOUNT SET UP?
	BNE	5$		; IF NE YES, CONTINUE
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR9,#ERR9SZ	; ISSUE INVALID OPERATION MESSAGE
	BR	ALLOC		; AND TRY AGAIN
5$:	CALL	CHWCHK		; ARE WE A CHAINED ACCOUNT?
	BCS	ALLOC		; IF CS YES, OPTION IS ILLEGAL
	MOV	CASH,A.MALL(R0)	; CHANGE HIGH ALLOCATION
	MOV	CASH+2,A.MALL+2(R0) ; AND LOW ALLOCATION
	CALL	$AFPUT		; RE-WRITE THE ACCOUNT
	CALL	$AFCLS		; AND CLOSE THE ACCOUNT FILE
	CALL	DSPLAY		; DISPLAY NEW PARAMETERS
	MOV	#FF.MMA,FCODE	; SET TRANSACTION TYPE
	CALL	RECORD		; AND LOG IT
	BR	ALLOC		; GET NEXT A/C TO UPDATE

	.IFF

	PRINT	#ERR6,#ERR6SZ	; OPTION NOT SUPPORTED

	.ENDC	; DF AA$MMA

10$:	RETURN			;
	.PAGE
	.SBTTL	CHAIN OPTION ROUTINE
;+
; *** CHAIN
;
;	THIS ROUTINE IS CALLED WHEN THE "C" OPTION IS SELECTED. IT CHAINS
;	AND ACCOUNT TO A MASTER ACCOUNT, OR, IF A ZERO MASTER ACCOUNT NUMBER
;	IS SUPPLIED, PERFORMS AN UNCHAINING OPERATION.
;
;-

CHAIN:	CALL	GETUIC		; GET UIC AND PASSWORD FOR MEMBER A/C
	TST	ESCAPE		; WAS AN ESCAPE TYPED?
	BEQ	10$		; IF EQ NO, CONTINUE
	RETURN			; RETURN TO CALLER
10$:	CALL	GETMAS		; GET ACCOUNT NUMBER FOR DESIRED MASTER
	CALL	OPENAF		; OPEN ACCOUNT FILE
	CALL	ACCNT		; LOCATE MEMBER ACCOUNT
	BCS	CHAIN		; IF CS CAN'T FIND ACCOUNT
	TST	A.ACNO(R0)	; ACCOUNT SET UP?
	BNE	42$		; IF NE YES, CONTINUE
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR9,#ERR9SZ	; ISSUE INVALID OPERATION MESSAGE
	BR	CHAIN		; AND TRY AGAIN
42$:	TST	ACNO		; IS THIS AN UNCHAINING OPERATION?
	BNE	43$		; IF NE NO
	TST	A.CHWD(R0)	; YES, IS THE ACCOUNT CHAINED?
	BNE	421$		; IF NE YES IT IS
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#ERR18,#ERR18S	; SEND A MESSAGE TO THE USER
	BR	CHAIN		; AND TRY AGAIN
421$:	CLR	A.CHWD(R0)	; CLEAR CHAIN WORD
	MOV	A.ACNO(R0),CHWD	; KEEP A/C NUM FOR LATER
	CALL	$AFPUT		; REWRITE THE ACCOUNT ENTRY
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#UCH,#UCHSZ	; TELL THE USER THAT WE DID IT OK
	JMP	9$		; RECORD THE TRANSACTION AND CONTINUE
43$:	CALL	CHWCHK		; IS THE ACCOUNT ALREADY CHAINED?
	BCS	CHAIN		; IF CS YES, USER MUST BREAK CHAIN FIRST
	BIT	#100000,A.ACNO(R0) ; ARE WE A MASTER ACCOUNT?
	BEQ	5$		; IF EQ NO, OK TO CONTINUE
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR12,#ERR12S	; PRINT ILLEGAL FUNCTION MESSAGE
	BR	CHAIN		; AND TRY AGAIN
5$:	MOV	#BUF,R1		; GET ADDRESS FOR TEMPORARY ACCOUNT COPY
	MOV	#<128./2>,R2	; SET NUMBER OF WORDS TO COPY
	MOV	R0,-(SP)	; SAVE ACCOUNT ENTRY POINTER
51$:	MOV	(R0)+,(R1)+	; COPY A WORD OF THE ENTRY
	DEC	R2		; ANY MORE TO COPY?
	BNE	51$		; IF NE YES, LOOP
	MOV	(SP)+,R0	; RESTORE ACCOUNT ENTRY POINTER
	MOV	#ACCPT2,$ASUBR	; SET ADDRESS OF ACCEPTANCE ROUTINE FOR
				; LOCATION OF MASTER ACCOUNT
	CALL	$ASCAN		; SEARCH FOR MASTER ACCOUNT
	BCC	6$		; GOOD, WE FOUND IT
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR13,#ERR13S	; PRINT MASTER NOT FOUND MESSAGE
	BR	CHAIN		; AND TRY AGAIN
6$:	BIT	#100000,A.ACNO(R0) ; IS THE MASTER FLAG SET?
	BNE	7$		; IF NE YES, OK
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR14,#ERR14S	; PRINT NOT MASTER STATUS MESSAGE
	BR	CHAIN		; AND TRY AGAIN
7$:	ADD	BUF+A.CASH+2,A.CASH+2(R0) ; ADD A/C'S BALANCE TO THAT OF
	ADC	A.CASH(R0)	;	... MASTER ACCOUNT
	ADD	BUF+A.CASH,A.CASH(R0) ;
	ADD	BUF+A.MALL+2,A.MALL+2(R0) ; ADD MONTHLY ALLOCATIONS...
	ADC	A.MALL(R0)	;
	ADD	BUF+A.MALL,A.MALL(R0) ;
	ADD	BUF+A.PREV+2,A.PREV+2(R0) ; ADD PREVIOUS DISK BLOCKS...
	ADC	A.PREV(R0)	;
	ADD	BUF+A.PREV,A.PREV(R0) ;
	ADD	BUF+A.BALL+2,A.BALL+2(R0) ; ADD BLOCK ALLOCATIONS...
	ADC	A.BALL(R0)	;
	ADD	BUF+A.BALL,A.BALL(R0) ;
	ADD	BUF+A.ABLK+2,A.ABLK+2(R0) ; ADD AVERAGE BLOCK USE
	ADC	A.ABLK(R0)	;
	ADD	BUF+A.ABLK,A.ABLK(R0) ;
	ADD	BUF+A.NDA,A.NDA(R0)   ; ADD NUMBER OF DISK ACCOUNTINGS
	ASR	A.NDA(R0)	; AND FIND THE AVERAGE
	CALL	$AFPUT		; REWRITE THE MASTER ACCOUNT ENTRY
	MOV	#ACCPT1,$ASUBR	; SET UP TO RELOCATE CHAINED A/C
	CALL	$ASCAN		; DO IT
	BCC	8$		; IF CC GOOD, WE FOUND IT
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR15,#ERR15S	; TELL USER OF ERROR
	JMP	CHAIN		; AND TRY AGAIN
8$:	MOV	ACNO,A.CHWD(R0)	; SET UP THE CHAIN LINKAGE
	MOV	A.ACNO(R0),CHWD	; AND REMEMBER OUR ACCOUNT NUMBER
	CLR	A.CASH(R0)	; REMOVE THE MONEY FROM THIS ACCOUNT
	CLR	A.CASH+2(R0)	;
	CLR	A.MALL(R0)	; AND THE MONTHLY ALLOCATION
	CLR	A.MALL+2(R0)	;
	CALL	$AFPUT		; REWRITE THE MEMBER ACCOUNT ENTRY
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#CHA,#CHASZ	; TELL THE USER WE DID IT
9$:	MOV	ACNO,R0		; BEFORE LOGGING THIS TRANSACTION...
	MOV	CHWD,ACNO	; ... WE MUST SWAP OVER "ACNO" AND "CHWD"
	MOV	R0,CHWD		; ... SINCE THE ABOVE CODE STORED THEM
				; IN THE REVERSE ORDER.
	MOV	#FF.CHA,FCODE	; SET THE TRANSACTION TYPE
	CALL	RECORD		; LOG IT
	JMP	CHAIN		; SEE IF THERE'S ANY MORE
	.PAGE
	.SBTTL	MASTER OPTION ROUTINE
;+
; *** MASTER
;
;	THIS ROUTINE IS CALLED WHEN THE "M" OPTION IS SELECTED. THE
;	REQUESTED ACCOUNT IS EXAMINED, AND IF THE OPTION IS FOUND TO
;	BE ACCEPTABLE, THE MASTER FLAG BIT (THE SIGN BIT OF THE
;	ACCOUNT NUMBER WORD) IS SET.
;
;-

MASTER:	CALL	GETUIC		; WHO ARE WE TALKING ABOUT?
	TST	ESCAPE		; END OF OPTION?
	BNE	20$		; IF NE YES
	CALL	OPENAF		; OPEN ACCOUNT FILE
	CALL	ACCNT		; LOCATE THE ACCOUNT
	BCS	MASTER		; IF CS NOT FOUND
	MOV	A.ACNO(R0),ACNO	; ACCOUNT SET UP?
	BNE	5$		; IF NE YES, CONTINUE
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#ERR9,#ERR9SZ	; ISSUE INVALID OPERATION MESSAGE
	BR	MASTER		; AND TRY AGAIN
5$:	CALL	CHWCHK		; IS ACCOUNT CHAINED?
	BCS	MASTER		; IF CS YES, NO CAN DO
	BIT	#100000,A.ACNO(R0) ; IS IT ALREADY A MASTER ACCOUNT?
	BEQ	10$		; IF EQ NO
	CALL	$AFCLS		; A/C ALREADY MASTER: CLOSE ACCOUNT FILE
	PRINT	#ERR10,#ERR10SZ	; ISSUE A MESSAGE
	BR	MASTER		; AND TRY AGAIN
10$:	BIS	#100000,A.ACNO(R0) ; SET MASTER FLAG BIT
	CALL	$AFPUT		; RE-WRITE ACCOUNT BLOCK
	CALL	$AFCLS		; CLOSE ACCOUNT FILE
	PRINT	#MYES,#MYESSZ	; SAY WE DID IT OK
	MOV	#FF.MAS,FCODE	; SET TRANSACTION TYPE
	CALL	RECORD		; AND LOG IT
	BR	MASTER		; PROPAGATE THE OPTION
20$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	DELETE MASTER OPTION ROUTINE
;+
; *** DELMST
;
;	THIS ROUTINE IS CALLED WHEN THE "N" OPTION IS SELECTED. THE
;	REQUESTED MASTER ACCOUNT IS EXAMINED, AND IF IT PASSES ALL THE
;	TESTS REQUIRED OF IT, THE MASTER STATUS IS DELETED.
;
;-

DELMST:	CALL	GETUIC		; READ IN UIC AND PASSWORD
	TST	ESCAPE		; WAS <ESC> TYPED?
	BNE	20$		; IF NE YES, END OF OPTION
	CALL	OPENAF		; OPEN THE ACCOUNT FILE
	CALL	ACCNT		; AND LOCATE THE ACCOUNT
	BCS	DELMST		; IF CS, ACCOUNT NOT FOUND
	MOV	A.ACNO(R0),ACNO	; ACCOUNT SET UP?
	BNE	5$		; IF NE YES
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#ERR9,#ERR9SZ	; AND ISSUE AN ERROR MESSAGE
	BR	DELMST		; TRY AGAIN
5$:	CALL	CHWCHK		; MAKE SURE WE'RE NOT CHAINED
	BCS	DELMST		; IF CS WE ARE, TRY AGAIN
	BIT	#100000,ACNO	; ARE WE A MASTER ACCOUNT?
	BNE	10$		; IF NE YES
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#ERR14,#ERR14S	; ISSUE AN ERROR MESSAGE
	BR	DELMST		; AND TRY AGAIN
10$:	BIC	#100000,ACNO	; ZAP THE MASTER FLAG BEFORE THE SEARCH
	MOV	#ACCPT3,$ASUBR	; SET ADDRESS OF ACCEPTANCE ROUTINE FOR
				; CHECKING FOR MEMBERS
	CALL	$ASCAN		; SEE IF ANYONE IS CHAINED TO US
	BCS	15$		; IF CS NO, GOOD
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#ERR19,#ERR19S	; AND ISSUE AN ERROR MESSAGE
	BR	DELMST		; YAWN
15$:	CALL	ACCNT		; SET US UP FOR THE MASTER AGAIN
	BCS	DELMST		; JUST IN CASE (MAYBE I/O ERROR...)
	BIC	#100000,A.ACNO(R0) ; CLEAR THE MASTER FLAG
	CALL	$AFPUT		; REWRITE THE ACCOUNT ENTRY
	CALL	$AFCLS		; CLOSE THE ACCOUNT FILE
	PRINT	#MNO,#MNOSZ	; TELL THE USER WE DID IT
	MOV	#FF.DMS,FCODE	; SET THE TRANSACTION CODE
	CALL	RECORD		; LOG IT
	BR	DELMST		; AND GO AGAIN
20$:	RETURN			; END OF OPTION, RETURN TO CALLER
	.PAGE
	.SBTTL	ROUTINE TO GET UIC
;+
; *** GETUIC
;
;	THIS ROUTINE READS THE USER IDENTIFICATION CODE AND PASSWORD
;	FROM THE TERMINAL. IF THE READ TERMINATOR IS <ESCAPE>, THE
;	ESCAPE FLAG IS SET AND THE ROUTINE TERMINATES, ELSE THE
;	TYPED INPUT IS VERIFIED.
;	THE ALLOWED FORMATS ARE:
;		G,M/PSWD
;		G/M/PSWD
;		[G,M]/PSWD
;		[G/M]/PSWD
;	IF THE PASSWORD IS NOT SUPPLIED, WE LOOK FOR THE FIRST ACCOUNT
;	IN THE ACCOUNT FILE, IRRESPECTIVE OF PASSWORD, THAT HAS THE
;	RIGHT UIC.
;-

GETUIC:	MOV	#PSWBUF,R1	; GET ADDRESS OF PASSWORD BUFFER
	MOV	#6,R2		; AND ITS LENGTH
5$:	MOVB	#SPA,(R1)+	; BLANK OUT A BYTE
	DEC	R2		; DONE YET?
	BNE	5$		; IF NE NO, LOOP
	PRINT	#USER,#USERSZ	; REQUEST UIC
	CALL	IORVB		; AND READ THEM
	CLR	ESCAPE		; ASSUME <ESC> WAS NOT TYPED
	CMPB	(R1),#33	; IS <ESC> THE READ TERMINATOR?
	BNE	20$		; IF NE NO
	INC	ESCAPE		; YES, SET ESCAPE FLAG
	RETURN			; AND RETURN TO CALLER
10$:	PRINT	#ERR1,#ERR1SZ	; SYNTAX ERROR
	BR	GETUIC		; TRY AGAIN FOR UIC
20$:	MOVB	#CR,(R1)	; FORCE CARRIAGE RETURN AS TERMINATOR
	CMPB	(R0),#'[	; DOES UIC START WITH [?
	BNE	25$		; IF NE NO
	INC	R0		; YES, NEXT DIGIT WILL BE START OF UIC
25$:	CALL	$GTNUM		; GET GROUP CODE
	MOV	R1,GRP		; STORE IT
	BEQ	10$		; ZERO IS BAD
	CMP	R1,#377		; VALID GROUP CODE
	BHI	10$		; IF HI NO
	CMPB	R2,#',		; SEPARATOR A COMMA?
	BEQ	26$		; IF EQ YES, OK
	CMPB	R2,#'/		; SEPARATOR A SLASH?
	BNE	10$		; IF NE NO, SYNTAX ERROR
26$:	CALL	$GTNUM		; GET MEMBER CODE
	MOV	R1,MEM		; AND SAVE IT
	BEQ	10$		; ZERO IS BAD
	CMP	R1,#377		; VALID MEMBER CODE
	BHI	10$		; IF HI NO
	CMPB	R2,#']		; DID UIC END WITH A "]" ?
	BEQ	30$		; IF EQ YES, LEAVE POINTER PAST IT
	DEC	R0		; NOT ], POINT BACK TO UIC TERMINATOR
30$:	CLRB	PSWBUF		; ASSUME PASSWORD NOT SPECIFIED
	CMPB	(R0),#CR	; END OF LINE (NO PASSWORD)?
	BEQ	50$		; IF EQ YES, PASSWORD NOT GIVEN
	CMPB	(R0)+,#'/	; PASSWORD COMING NEXT?
	BNE	10$		; IF NE, SYNTAX ERROR
	MOV	#PSWBUF,R1	; GET ADDRESS OF PASSWORD BUFFER
	MOV	#7,R3		; AND ITS LENGTH
40$:	CMPB	(R0),#CR	; END OF PASSWORD YET?
	BEQ	50$		; IF EQ YES
	DEC	R3		; NO, ANY MORE SPACE IN BUFFER?
	BEQ	10$		; IF EQ NO, SYNTAX ERROR (PSWD TOO LONG)
	MOVB	(R0)+,R2	; GET NEXT PASSWORD CHARACTER
	CALL	LCASE		; MAKE SURE IT IS UPPER CASE
	MOVB	R2,(R1)+	; SAVE IN PASSWORD BUFFER
	BR	40$		; AND GET THE NEXT CHARACTER
50$:	MOV	PC,R2		; SET TO GENERATE LEADING ZEROES
	MOV	#UIC,R0		; POINT TO MEMBER CODE AREA
	MOV	MEM,R1		; RETRIEVE MEMBER CODE
	CALL	$CBOMG		; CONVERT MEMBER TO ASCII
	MOV	#UIC-3,R0	; POINT TO GROUP CODE AREA
	MOV	GRP,R1		; RETRIEVE GROUP CODE
	CALLR	$CBOMG		; CONVERT TO ASCII AND RETURN
	.PAGE
	.SBTTL	GET MASTER A/C NUMBER ROUTINE
;+
; *** GETMAS
;
;	THIS ROUTINE IS CALLED DURING "C" OPTION PROCESSING TO GET
;	THE ACCOUNT NUMBER OF THE DESIRED MASTER ACCOUNT.
;
;-

GETMAS:	PRINT	#MSTR,#MSTRSZ	; PROMPT FOR ACCOUNT NUMBER
	CALL	IORVB		; READ THE DATA TYPED
	CALL	$GTNUM		; CONVERT NUMBER TO BINARY
	MOV	R1,ACNO		; SAVE THE RESULT
	BGE	10$		; IF GE IT'S OK
				; (ZERO IS ACCEPTABLE AS IT IMPLIES
				; AN UNCHAINING OPERATION)
	PRINT	#ERR1,#ERR1SZ	; PRINT SYNTAX ERROR MESSAGE
	BR	GETMAS		; AND TRY AGAIN
10$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	GET ACCOUNT NUMBER ROUTINE
;+
; *** GETACN
;
;	THIS ROUTINE IS CALLED FROM THE "S" OPTION TO READ A NEW
;	ACCOUNT NUMBER FROM THE TERMINAL.
;
;-

GETACN:	PRINT	#ACN,#ACNSZ	; PROMPT FOR ACCOUNT NUMBER
	CALL	IORVB		; AND READ IT IN
	CALL	$GTNUM		; CONVERT IT TO BINARY
	MOV	R1,ACNO		; SAVE THE RESULT
	BGT	10$		; IF GT IT IS LEGAL
	PRINT	#ERR1,#ERR1SZ	; SEND SYNTAX ERROR MESSAGE
	BR	GETACN		; AND TRY AGAIN
10$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	GET BLOCK ALLOCATION ROUTINE
;+
; *** GETBLK
;
; GET BLOCK ALLOCATION
;
;-

	.IF DF	AA$BLK

GETBLK:	PRINT	#GTBLOK,#GBSIZE	; TYPE PROMPT
	CALL	IORVB		; READ BLOCK INPUT
	MOV	#BLOCKS,R3	; SET ADDRESS FOR RESULT OF CONVERSION
	MOV	IOSB+2,R4	; SET NUMBER OF CHARACTERS READ
	MOV	R0,R5		; SET ADDRESS OF TYPED STRING
	CALL	.OD2CT		; CONVERT TO BINARY (DEFAULT RADIX=OCTAL)
	BCC	20$		; IF CC IT WAS LEGAL
10$:	PRINT	#ERR1,#ERR1SZ	; ERROR
	BR	GETBLK		; TRY AGAIN
20$:	TST	BLOCKS		; WAS IT POSITIVE?
	BLT	10$		; IF LT NO, SYNTAX ERROR
	RETURN			; RETURN TO CALLER

	.ENDC	; DF AA$BLK
	.PAGE
	.SBTTL	GET TRANSACTION AMOUNT ROUTINE
;+
; *** GETTRN
;
;	THIS ROUTINE READS FROM THE TERMINAL THE AMOUNT OF MONEY REQUIRED
;	IN THIS TRANSACTION, AND CONVERTS IT TO ACCOUNTING UNITS.
;	THE AMOUNT MAY BE TYPED WITH AN OPTIONAL LEADING + SIGN IF IT IS
;	POSITIVE (THE DEFAULT) OR A - SIGN IF IT IS NEGATIVE, AND SHOULD
;	ALWAYS INCLUDE EXACTLY TWO PLACES AFTER THE DECIMAL POINT (THAT
;	IS, A WHOLE NUMBER OF CENTS IS ENTERED).
;
;-

GETTRN:	PRINT	#TRANS,#TRANSZ	; PROMPT FOR AMOUNT
	CALL	IORVB		; GET SOME DATA
	CLR	NEGFLG		; CLEAR NEGATIVE FLAG (ASSUME +VE)
	CMPB	(R0),#'+	; LOOK FOR LEADING "+"
	BEQ	10$		; FOUND IT
	CMPB	(R0),#'-	; LOOK FOR LEADING "-"
	BNE	20$		; IF NE NO, NOT THERE
	INC	NEGFLG		; SET NEGATIVE FLAG
10$:	INC	R0		; STEP PAST SIGN
20$:	MOV	#CASH+2,R4	; GET ADDRESS OF NUMBER LOCATION+2
	CLR	(R4)		; CLEAR LOW ORDER RESULT
	CLR	-(R4)		; CLEAR HIGH ORDER RESULT
	MOV	#7,R5		; SET NUMBER OF CHARACTERS TO SCAN
30$:	MOVB	(R0)+,R2	; GET NEXT CHARACTER
	CMPB	R2,#'.		; IS IT A "."?
	BEQ	40$		; IF EQ YES
	CALL	CVTDIG		; IS IT A NUMERIC CHARACTER?
	BCS	50$		; IF CS NO
	CALL	MUL10		; MULTIPLY OLD RESULT BY 10.
	ADD	R2,2(R4)	; ACCUMULATE MORE RESULT
	ADC	(R4)		; DON'T FORGET THE CARRY
	DEC	R5		; DECREMENT COUNT
	BEQ	50$		; IF EQ NONE LEFT
	BR	30$		; TRY NEXT DIGIT
40$:	MOVB	(R0)+,R2	; GET FIRST DIGIT OF CENTS
	CALL	CVTDIG		; CHECK  IT
	BCS	50$		; ILLEGAL
	MOV	R2,R3		; STORE CENTS
	ASL	R3		; MULTIPLY BY TWO
	MOV	R3,-(SP)	; SAVE IT ON THE STACK
	ASL	R3		; MULTIPLY BY TWO AGAIN
	ASL	R3		; AND AGAIN
	ADD	(SP)+,R3	; IT IS NOW MULTIPLIED BY TEN
	MOVB	(R0),R2		; GET SECOND DIGIT OF CENTS
	CALL	CVTDIG		; CONVERT TO NUMBER
	BCS	50$		; ILLEGAL
	ADD	R2,R3		; ADD IN TO TENS
	CALL	MUL10		; CONVERT DOLLARS TO CENTS
	CALL	MUL10		;
	ADD	R3,2(R4)	; ADD CENTS TO DOLLARS
	ADC	(R4)		;
	CALL	MUL10		; MULTIPLY BY 100. (CONVERT TO ACC. UNITS)
	CALL	MUL10		;
	TST	NEGFLG		; CHECK NEGATIVE FLAG
	BEQ	60$		; NUMBER IS POSITIVE
	NEG	(R4)+		; COMPLEMENT HIGH ORDER (CHANGE SIGN)
	NEG	(R4)		; COMPLEMENT LOW ORDER
	SBC	-(R4)		; DON'T FORGET THE CARRY
	BR	60$		;
50$:	PRINT	#ERR1,#ERR1SZ	; SYNTAX ERROR
	BR	GETTRN		; TRY AGAIN
60$:	RETURN			; RETURN
	.PAGE
	.SBTTL	OPTION TEXT ROUTINE
;+
; *** OPTXT
;
;	THIS ROUTINE READS IN UP TO 40 BYTES OF TEXT FOR THE "S" AND "U"
;	OPTIONS. THIS TEXT IS STORED IN THE TRANSACTIONS FILE SHOULD THE
;	ATTEMPT BE SUCCESSFUL, AND MAY BE DISPLAYED BY A REPORTING
;	PROGRAM IF DESIRED.
;
;-

OPTXT:	PRINT	#TEXT,#TEXTSZ	; PROMPT FOR DESCRIPTIVE TEXT
	CALL	IORVB		; READ IN THE TEXT
	MOVB	#CR,(R1)	; ENSURE <CR> AS TERMINATOR
	MOV	#F.LTXT,R2	; SET MAX. LENGTH OF DESCRIPTIVE TEXT
	MOV	#OPTEXT,R1	; AND GET THE TEXT BUFFER ADDRESS
10$:	CMPB	(R0),#CR	; END OF TEXT YET?
	BEQ	20$		; IF EQ YES
	MOVB	(R0)+,(R1)+	; ELSE COPY IN THE TEXT
	DEC	R2		; UPDATE BYTE COUNTER
	BNE	10$		; IF NE WE CAN MOVE MORE SO LOOP
	BR	30$		; ELSE RETURN
20$:	MOVB	#SPA,(R1)+	; BLANK OUT A BYTE
	DEC	R2		; END OF BUFFER YET?
	BNE	20$		; IF NE NO, LOOP
30$:	RETURN			; THAT'S IT, RETURN TO CALLER
	.PAGE
	.SBTTL	ACCOUNT FILE OPEN ROUTINE
;+
; *** OPENAF
;
;	THIS ROUTINE IS CALLED TO OPEN THE RSX SYSTEM ACCOUNT FILE.
;	IF 5 OPEN ERRORS ARE DETECTED, THE PROGRAM IS TERMINATED
;	IMMEDIATELY WITH AN APPROPRIATE ERROR MESSAGE.
;
;-

OPENAF:	CALL	$AFOPN		; OPEN A/C FILE
	BCC	10$		; OPEN SUCCESSFUL
	PRINT	#ERR3,#ERR3SZ	; SEND OUT OPEN FAILURE MESSAGE
	JMP	EXIT		; TERMINATE PROGRAM IMMEDIATELY
10$:	RETURN			;
	.PAGE
	.SBTTL	DISPLAY ACCOUNT PARAMETERS ROUTINE
;+
; *** DSPLAY
;
; DISPLAY ACCOUNT PARAMETERS
;
;	ON ENTRY TO THIS ROUTINE, "ENTRY" CONTAINS THE ADDRESS OF THE
;	ACCOUNT ENTRY IN THE INTERNAL BUFFER.
;
;-

DSPLAY:	DIR$	#DPBATT		; ATTACH TO TI:
	MOV	ENTRY,R5	; GET ENTRY ADDRESS
	MOV	#BUF,R0		; GET OUTPUT BUFFER ADDRESS
	MOVB	#CR,(R0)+	; INSERT CR-LF PAIR
	MOVB	#LF,(R0)+	;
	MOVB	#'[,(R0)+	; START UIC
	MOVB	(R5)+,(R0)+	; MOVE IN GROUP CODE
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	#',,(R0)+	; INSERT A COMMA
	MOVB	(R5)+,(R0)+	; MOVE IN MEMBER CODE
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	#'],(R0)+	; FINISH UIC
	MOVB	#SPA,(R0)+	; INSERT A SPACE
	ADD	#<A.FNM-6>,R5	; POINT R5 TO FIRST NAME
	MOV	#12.,R1		; SET MAXIMUM CHARACTERS TO MOVE
10$:	MOVB	(R5),(R0)+	; MOVE A CHARACTER OF THE NAME
	CMPB	(R5)+,#SPA	; WAS IT A SPACE?
	BEQ	11$		; IF EQ YES, END OF FIRST NAME
	DEC	R1		; NO, ANY MORE CHARACTERS TO MOVE?
	BNE	10$		; IF NE YES, DO IT
	MOVB	#SPA,(R0)+	; FINISH NAME WITH A SPACE
11$:	MOV	ENTRY,R5	; POINT R5 TO LAST NAME
	ADD	#A.LNM,R5	;
	MOV	#14.,R1		; SET MAXIMUM LENGTH OF NAME
12$:	MOVB	(R5),(R0)+	; MOVE A CHARACTER
	CMPB	(R5)+,#SPA	; WAS IT A SPACE?
	BEQ	13$		; IF EQ YES, END OF NAME
	DEC	R1		; NO, ANY MORE TO MOVE?
	BNE	12$		; IF NE YES, GO TO IT
	MOVB	#SPA,(R0)+	; INSERT A SPACE
13$:	MOVSTR	#SYDEV		; INSERT SYSTEM DEVICE TEXT
	MOV	ENTRY,R5	; YAWN YAWN
	ADD	#A.SYDV,R5	; POINT TO SYSTEM DEVICE
	MOVB	(R5)+,(R0)+	; MOVE IN SYSTEM DEVICE NAME
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOV	<A.ACNO-A.SYDV-4>(R5),R1 ; GET ACCOUNT NUMBER
	BNE	14$		; IF NE ACCOUNT WAS SET UP
	MOVSTR	#NOSET		; SAY A/C NOT SET UP
	BR	15$		; AND PRINT IT OUT
14$:	MOVSTR	#ACSTR,SAVER1	; INSERT A/C NUMBER TEXT
	MOV	R1,-(SP)	; SAVE ACCOUNT NUMBER ON STACK
	BIC	#100000,R1	; CLEAR MASTER FLAG (IF SET)
	CALL	OC.TAL		; FORMAT AS ASCII OCTAL
	BIT	#100000,(SP)+	; WAS THE ACCOUNT A MASTER?
	BEQ	15$		; IF EQ NO
	MOVSTR	#MSTAT		; ELSE INSERT MASTER STATUS TEXT
15$:	SUB	#BUF,R0		; CALCULATE LENGTH OF STRING
	PRINT	#BUF,R0		; TYPE IT OUT
	TST	<A.ACNO-A.SYDV-4>(R5) ; ANYTHING ELSE TO PRINT?
	BEQ	20$		; IF EQ NO (A/C NOT SET UP)
	MOV	<A.CHWD-A.SYDV-4>(R5),R1 ; GET ACCOUNT CHAIN WORD
	BEQ	16$		; IF EQ ACCOUNT IS NOT CHAINED
	MOV	#CHTXT1,R0	; SET ADDRESS FOR MASTER A/C NUMBER
	CALL	OC.TAL		; FORMAT AS ASCII OCTAL
	SUB	#CHTXT,R0	; CALCULATE MESSAGE LENGTH
	PRINT	#CHTXT,R0	; AND PRINT IT
	BR	20$		; THAT'S IT
16$:				; REF. LABEL

	.IF DF	AA$BLK

	MOV	#BLK1,R0	; GET BUFFER ADDRESS FOR BLOCK ALLOCATION
	MOV	ENTRY,R5	; GET ACCOUNT ENTRY ADDRESS
	MOV	R5,R1		; COPY IT TO R1
	ADD	#A.BALL,R1	; POINT R1 TO BLOCK ALLOCATION
	CALL	FM.QIO		; FORMAT AS DECIMAL
	MOVSTR	#CURB		; INSERT AVERAGE BLOCKS MESSAGE
	MOV	R5,R1		; POINT R1 TO AVERAGE BLOCKS
	ADD	#A.ABLK,R1	;
	CALL	FM.QIO		; FORMAT AS ASCII DECIMAL
	SUB	#BLK,R0		; CALCULATE MESSAGE LENGTH
	PRINT	#BLK,R0		; SEND IT OUT

	MOV	#BUF,R0		; GET OUTPUT BUFFER ADDRESS
	MOVSTR	#WEEK1		; INSERT "DISK CHARGES" MESSAGE
	MOV	ENTRY,R5	; GET ACCOUNT ENTRY ADDRESS
	MOV	A.PREV(R5),DSKCHG ; COPY BLOCKS AS OF LAST DISK ACCOUNTING
	MOV	A.PREV+2(R5),DSKCHG+2 ;
	CALL	FILDSK		; INSERT CURRENT DISK CHARGE	
	MOVSTR	#WEEK2		; INSERT "AT TODAY'S USAGE RATE,"
	MOV	ENTRY,R5	; GET ENTRY ADDRESS
	MOV	A.ABLK(R5),DSKCHG ; COPY AVERAGE BLOCKS
	MOV	A.ABLK+2(R5),DSKCHG+2 ;
	CALL	FILDSK		; INSERT AVERAGE DISK CHARGE
	MOVSTR	#WEEK3		; INSERT "AT AVERAGE USAGE RATE"
	SUB	#BUF,R0		; CALCULATE MESSAGE LENGTH
	PRINT	#BUF,R0		; SEND IT OUT

	.ENDC	; DF AA$BLK

	MOV	#BAL1,R0	; GET BUFFER ADDRESS FOR BALANCE
	MOV	ENTRY,R1	; YAWN
	ADD	#A.CASH,R1	; POINT TO ACCOUNT BALANCE
	CALL	FM.CHG		; FORMAT THE BALANCE
	SUB	#BAL,R0		; GET MESSAGE LENGTH
	PRINT	#BAL,R0		; TYPE IT OUT

	.IF DF	AA$MMA

	MOV	#MMA1,R0	; SAME AS ABOVE FOR MONTHLY ALLOCATION
	MOV	ENTRY,R1	; POINT R1 TO MONTHLY ALLOCATION
	ADD	#A.MALL,R1	;
	CALL	FM.CHG		; FORMAT BALANCE
	SUB	#MMA,R0		; MESSAGE LENGTH
	PRINT	#MMA,R0		; SEND IT OUT

	.ENDC	; DF AA$MMA

20$:	DIR$	#DPBDET		; DETACH FROM TI:
	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	WRITE ACCOUNT ENTRY TO DUMP FILE ROUTINE
;+
; *** ACDUMP
;
; 	THIS ROUTINE WRITES INFORMATION CONCERNING AN ACCOUNT TO
;	THE DUMP FILE.
;
;	ON ENTRY TO THIS ROUTINE, "ENTRY" CONTAINS THE ADDRESS OF THE
;	ACCOUNT ENTRY IN THE INTERNAL BUFFER.
;
;-

ACDUMP:	MOV	ENTRY,R5	; GET ENTRY ADDRESS
	MOV	#BUF,R0		; GET OUTPUT BUFFER ADDRESS
	MOVB	#LF,(R0)+	; INSERT A LINEFEED
	MOVB	#'[,(R0)+	; START UIC
	MOVB	(R5)+,(R0)+	; MOVE IN GROUP CODE
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	#',,(R0)+	; INSERT A COMMA
	MOVB	(R5)+,(R0)+	; MOVE IN MEMBER CODE
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	#'],(R0)+	; FINISH UIC
	MOVB	#SPA,(R0)+	; INSERT A SPACE
	ADD	#<A.FNM-6>,R5	; POINT R5 TO FIRST NAME
	MOV	#12.,R1		; SET MAXIMUM CHARACTERS TO MOVE
10$:	MOVB	(R5),(R0)+	; MOVE A CHARACTER OF THE NAME
	CMPB	(R5)+,#SPA	; WAS IT A SPACE?
	BEQ	11$		; IF EQ YES, END OF FIRST NAME
	DEC	R1		; NO, ANY MORE CHARACTERS TO MOVE?
	BNE	10$		; IF NE YES, DO IT
	MOVB	#SPA,(R0)+	; FINISH NAME WITH A SPACE
11$:	MOV	ENTRY,R5	; POINT R5 TO LAST NAME
	ADD	#A.LNM,R5	;
	MOV	#14.,R1		; SET MAXIMUM LENGTH OF NAME
12$:	MOVB	(R5),(R0)+	; MOVE A CHARACTER
	CMPB	(R5)+,#SPA	; WAS IT A SPACE?
	BEQ	13$		; IF EQ YES, END OF NAME
	DEC	R1		; NO, ANY MORE TO MOVE?
	BNE	12$		; IF NE YES, GO TO IT
	MOVB	#SPA,(R0)+	; INSERT A SPACE
13$:	MOVSTR	#SYDEV		; INSERT SYSTEM DEVICE TEXT
	MOV	ENTRY,R5	; YAWN YAWN
	ADD	#A.SYDV,R5	; POINT TO SYSTEM DEVICE
	MOVB	(R5)+,(R0)+	; MOVE IN SYSTEM DEVICE NAME
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOVB	(R5)+,(R0)+	;
	MOV	<A.ACNO-A.SYDV-4>(R5),R1 ; GET ACCOUNT NUMBER
	BNE	14$		; IF NE ACCOUNT WAS SET UP
	MOVSTR	#NOSET		; SAY A/C WAS NOT SET UP
	BR	15$		; AND PRINT IT
14$:	MOVSTR	#ACSTR,SAVER1	; INSERT A/C NUMBER TEXT
	MOV	R1,-(SP)	; SAVE ACCOUNT NUMBER ON STACK
	BIC	#100000,R1	; CLEAR MASTER FLAG (IF SET)
	CALL	OC.TAL		; FORMAT AS ASCII OCTAL
	BIT	#100000,(SP)+	; WAS THE ACCOUNT A MASTER?
	BEQ	15$		; IF EQ NO
	MOVSTR	#MSTAT		; ELSE INSERT MASTER STATUS TEXT
15$:	SUB	#BUF,R0		; CALCULATE LENGTH OF STRING
	MOV	R0,R1		; COPY IT
	PUT$	#FDB,#BUF,R1	; WRITE TO THE DUMP FILE
	TST	<A.ACNO-A.SYDV-4>(R5) ; ANYTHING ELSE TO PRINT?
	BEQ	20$		; IF EQ NO (A/C NOT SET UP)
	MOV	<A.CHWD-A.SYDV-4>(R5),R1 ; GET ACCOUNT CHAIN WORD
	BEQ	16$		; IF EQ ACCOUNT IS NOT CHAINED
	DEC	NEGFLG		; SHOW ONE MORE ENTRY ON CURRENT PAGE
	MOV	#CHTXT1,R0	; SET ADDRESS FOR MASTER A/C NUMBER
	CALL	OC.TAL		; FORMAT AS ASCII OCTAL
	SUB	#CHTXT,R0	; CALCULATE MESSAGE LENGTH
	MOV	R0,R1		; COPY IT
	PUT$	#FDB,#CHTXT,R1	; WRITE IT TO LISTING FILE
	BR	20$		; THAT'S IT
16$:				; REF. LABEL

	.IF DF	AA$BLK

	MOV	#BLK1,R0	; GET BUFFER ADDRESS FOR BLOCK ALLOCATION
	MOV	ENTRY,R5	; GET ACCOUNT ENTRY ADDRESS
	MOV	R5,R1		; COPY IT TO R1
	ADD	#A.BALL,R1	; POINT R1 TO BLOCK ALLOCATION
	CALL	FM.QIO		; FORMAT AS DECIMAL
	MOVSTR	#CURB		; INSERT AVERAGE BLOCKS MESSAGE
	MOV	R5,R1		; POINT R1 TO AVERAGE BLOCKS
	ADD	#A.ABLK,R1	;
	CALL	FM.QIO		; FORMAT AS ASCII DECIMAL
	SUB	#BLK,R0		; CALCULATE MESSAGE LENGTH
	MOV	R0,R1		; COPY IT
	PUT$	#FDB,#BLK,R1	; WRITE TO DUMP FILE

	.ENDC	; DF AA$BLK

	MOV	#BAL1,R0	; GET BUFFER ADDRESS FOR BALANCE
	MOV	ENTRY,R1	; YAWN
	ADD	#A.CASH,R1	; POINT TO ACCOUNT BALANCE
	CALL	FM.CHG		; FORMAT THE BALANCE
	SUB	#BAL,R0		; GET MESSAGE LENGTH
	MOV	R0,R1		; COPY IT
	PUT$	#FDB,#BAL,R1	; AND WRITE TO DUMP FILE

	.IF DF	AA$MMA

	MOV	#MMA1,R0	; SAME AS ABOVE FOR MONTHLY ALLOCATION
	MOV	ENTRY,R1	; POINT R1 TO MONTHLY ALLOCATION
	ADD	#A.MALL,R1	;
	CALL	FM.CHG		; FORMAT BALANCE
	SUB	#MMA,R0		; MESSAGE LENGTH
	MOV	R0,R1		; COPY IT
	PUT$	#FDB,#MMA,R1	; WRITE TO DUMP FILE

	.ENDC	; DF AA$MMA

20$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	DISK CHARGE CALCULATION ROUTINE

;+
; *** FILDSK
;
;	THOIS ROUTINE IS CALLED TO CALCULATE AND FORMAT IN THE CURRENT
;	OUTPUT BUFFER A DISK CHARGE, BASED ON THE NUMBER OF BLOCKS
;	SUPPLIED.
;
;	INPUT:
;		R0	CURRENT BUFFER POSITION
;		ENTRY	ACCOUNT ENTRY ADDRESS
;		DSKCHG	NUMBER OF BLOCKS TO CALCULATE CHARGE FOR.
;
;	OUTPUTS:
;		R0	UPDATED
;		DSKCHG	USED
;
;-

	.IF DF	AA$BLK

FILDSK:	MOV	R0,-(SP)	; SAVE BUFFER POINTER
	MOV	ENTRY,R5	; GET ACCOUNT ENTRY ADDRESS
	MOV	DSKCHG,R2	; COPY SPECIFIED BLOCKS
	MOV	DSKCHG+2,R3	;
	MOV	R2,R0		; AND AGAIN
	MOV	R3,R1		;
	SUB	A.BALL+2(R5),R1	; SUBTRACT DISK BLOCK ALLOCATION
	SBC	R0		;
	SUB	A.BALL(R5),R0	;
	BLT	8$		; IF LT, USE IS BELOW ALLOCATION
	ADD	R1,R3		; ADD EXCESS TO USE (THIS DOUBLES
	ADC	R2		; THE BLOCKS IN EXCESS)
	ADD	R0,R2		;

8$:	MOV	R2,R0		; COPY HIGH ORDER BLOCK USAGE AGAIN
	BNE	10$		; IF NE, NO MINIMUM CHARGE APPLIES
	MOV	R3,R1		; COPY LOW ORDER BLOCK USAGE
	SUB	#$BLKMN,R1	; SUBTRACT MINIMUM USAGE
	SBC	R0		;
	BGE	10$		; IF GE, NO MINIMUM USE
	MOV	#$BLKMN,R3	; RESET MINIMUM BLOCK USAGE

10$:	MOV	ELAPS,R0	; GET TIME IN MINUTES
	CALL	$DMUL		; CALCULATE TIME(MINS)*(BLOCKS)
	MOV	#DSKCHG+2,R5	; GET ADDRESS OF BUFFER FOR ML.DV
	MOV	R1,(R5)		; SAVE RESULT OF MULTIPLICATION
	MOV	R0,-(R5)	;
	MOV	#DSKBLK,R4	; GET ARGUMENT BLOCK ADDRESS
	CALL	ML.DV		; DO THE SECOND PART OF THE CALCULATION
	MOV	R1,DSKCHG	; SAVE HIGH ORDER RESULT
	MOV	R2,DSKCHG+2	; SAVE LOW ORDER RESULT
	MOV	(SP)+,R0	; RESTORE BUFFER POINTER
	MOV	#DSKCHG,R1	; POINT R1 TO RESULTING CHARGE
	CALL	FM.CHG		; FORMAT THE CHARGE

	.IF NDF	AA$UNI

	DEC	R0		; REMOVE THE LAST DIGIT

	.ENDC	; NDF AA$UNI

	RETURN			; AND RETURN TO CALLER

	.ENDC	; DF AA$BLK
	.PAGE
	.SBTTL	TRANSACTION RECORDING ROUTINE
;+
; *** RECORD
;
;	THIS ROUTINE IS CALLED TO MAKE AN ENTRY IN THE ACCOUNTING DATA
;	RECORDS FILE WHENEVER AN OPTION IS EXECUTED THAT MAKES A CHANGE
;	IN THE ACCOUNT FILE.
;
;-

RECORD:	CALL	$RFOPN		; OPEN THE ACCOUNTING DATA FILE
	BCC	10$		; IF CC OPEN WAS SUCCESSFUL
	MOVB	F.ERR(R0),R1	; GET FCS ERROR CODE
	MOV	#ERR16A,R0	; GET ADDRESS OF PLACE TO STICK IT
	CALL	DC.SGN		; FORMAT AS ASCII SIGNED DECIMAL
	SUB	#ERR16,R0	; CALCULATE MESSAGE LENGTH
	PRINT	#ERR16,R0	; AND PRINT IT
	RETURN			; AND RETURN TO CALLER
10$:	MOV	#$RFREC,R0	; GET DATA BUFFER ADDRESS
	MOV	FCODE,(R0)	; INSERT FUNCTION CODE
	ADD	#F.UIC,R0	; NOW POINT TO UIC SLOT
	MOVB	MEM,(R0)+	; INSERT MEMBER CODE
	MOVB	GRP,(R0)+	; INSERT GROUP CODE
	MOV	ACNO,(R0)+	; INSERT ACCOUNT NUMBER
	MOV	CHWD,(R0)+	; INSERT CHAIN WORD
	MOV	CHWD,(R0)+	; AND DUPLICATE IT
	MOV	LUNBUF+G.LUNA,(R0)+ ; INSERT TT: DEVICE NAME
	MOVB	LUNBUF+G.LUNU,(R0)+ ; INSERT DEVICE NUMBER (OUR TI:)
	INC	R0		; NEXT BYTE IS ZERO
				; R0 SHOULD NOW POINT TO F.INFO OFFSET
				; FROM BUFFER READY FOR FUNCTION SPECIFIC DATA
	MOV	FCODE,R1	; GET TRANSACTION CODE
	SUB	#FF.SET,R1	; CONVERT TO FUNCTION TABLE INDEX
	ASL	R1		;
	ASL	R1		;
	ADD	#FNCTAB,R1	; LOCATE FUNCTION TABLE ENTRY
	MOV	(R1)+,$RFLEN	; SET DATA RECORD LENGTH
	CALL	@(R1)		; FILL IN ANY ADDITIONAL DATA
	CALL	$RFPUT		; WRITE DATA TO THE FILE
	CALLR	$RFCLS		; AND CLOSE IT
FNSET:	CALL	FNBLK		; SET SERVICE ROUTINE
FNMMA:				; MMA SERVICE ROUTINE
FNUPD:	MOV	CASH,(R0)+	; UPD SERVICE ROUTINE, SAVE CASH AMOUNT
	MOV	CASH+2,(R0)+	;
	CMP	FCODE,#FF.SET	; "S" TRANSACTION?
	BEQ	1$		; IF EQ YES
	CMP	FCODE,#FF.UPD	; "U" TRANSACTION?
	BNE	2$		; IF NE NO
1$:	CALL	COPTXT		; COPY DESCRIPTIVE TEXT
2$:	RETURN			;
FNBLK:	MOV	BLOCKS,(R0)+	; BLK SERVICE ROUTINE, SAVE BLOCKS
	MOV	BLOCKS+2,(R0)+	;
FNCHA:				; CHA SERVICE ROUTINE
FNMAS:				; MAS SERVICE ROUTINE
FNDMS:				; DMS SERVICE ROUTINE
	RETURN			; RETURN TO RECORD
COPTXT:	MOV	#OPTEXT,R1	; GET ADDRESS OF DESCRIPTIVE TEXT BUFFER
	MOV	#F.LTXT,R2	; AND ITS LENGTH
1$:	MOVB	(R1)+,(R0)+	; COPY A CHARACTER
	DEC	R2		; DONE YET?
	BNE	1$		; IF NE NO, LOOP
	RETURN			; RETURN TO SERVICE ROUTINE
	.PAGE
	.SBTTL	PROGRAM EXIT ROUTINE
;+
; *** EXIT
;
;	THIS ROUTINE IS CALLED WHEN THE "X" OPTION HAS BEEN SELECTED,
;	OR WHENEVER CTRL/Z IS TYPED WHEN INPUT IS REQUESTED OR WHEN
;	AN ACCOUNT FILE OPEN FAILURE OCCURS. PROGRAM EXECUTION IS
;	TERMINATED AND A MESSAGE ISSUED.
;
;-

EXIT:	CALL	$AFCLS		; MAKE SURE ACCOUNT FILE IS CLOSED
	PRINT	#XM,#XMSIZ	; SEND EXIT MESSAGE
	EXIT$S			; EXIT
	.PAGE
	.SBTTL	LOWER TO UPPER CASE CONVERSION ROUTINE
;+
; *** LCASE
;
;	CONVERTS THE INPUT CHARACTER IN R2 TO UPPER CASE IF IT IS
;	A LOWER CASE CHARACTER.
;
;-

LCASE:	CMPB	R2,#140		; IS IT LOWER CASE?
	BLOS	10$		; IF LOS NO
	CMPB	R2,#172		; MAYBE
	BHI	10$		; IF HI NO
	BICB	#40,R2		; YES, CONVERT TO UPPER CASE
10$:	RETURN			; RETURN TO CALLER
	.PAGE
	.SBTTL	MULTIPLY BY 10 ROUTINE
;+
; *** - MUL10  - MULTIPLY 2 WORD INTEGER BY TEN
;
; INPUT:
;	R4 - ADDRESS OF 2-WORD BLOCK CONTAINING INTEGER
;
; OUTPUT:
;	NUMBER AT R4 IS MULTIPLIED BY 10.
;	ALL REGISTERS ARE PRESERVED.
;
;-

MUL10:	ASL	2(R4)		; MULTIPLY BY TWO
	ROL	(R4)		;
	MOV	(R4)+,-(SP)	; SAVE HIGH ORDER BITS
	MOV	(R4),-(SP)	; AND LOW ORDER
	ASL	(R4)		; MULTIPLY BY TWO AGAIN
	ROL	-(R4)		;
	ASL	2(R4)		; AND BY TWO AGAIN
	ROL	(R4)+		;
	ADD	(SP)+,(R4)	; ADD DOUBLE ORIGINAL RESULT TO GIVE ANSWER
	ADC	-(R4)		;
	ADD	(SP)+,(R4)	;
	RETURN			; FINISHED
	.PAGE
	.SBTTL	CHECK CHARACTER FOR NUMERIC LEGALITY
;+
; *** CVTDIG - CHECK THAT CHARACTER IS NUMERIC AND CONVERT IT
;
; INPUT:
;	R2 - CONTAINS CHARACTER
;
; OUTPUTS:
;	R2 - CONTAINS CONVERTED DIGIT
;	CARRY CLEAR - CHARACTER WAS LEGAL (NUMERIC)
;	CARRY SET - CHARACTER WAS ILLEGAL
;
;-

CVTDIG:	SUB	#'0,R2		; CONVERT TO A VALUE
	BLO	10$		; ILLEGAL (TOO SMALL)
	CMP	R2,#10.		; GREATER THAN OR EQUAL TO TEN?
	BHIS	10$		; IF HIS YES, ERROR
	CLC			; SET SUCCESS
	RETURN			; RETURN TO CALLER
10$:	SEC			; SET FAILURE
	RETURN			; AND RETURN
	.PAGE
	.SBTTL	SEARCH A/C FILE FOR ACCOUNT
;+
; *** - ACCNT  -  SEARCH FILE FOR ACCOUNT NUMBER
;
; OUTPUT:
;	ENTRY - ADDRESS OF ACCOUNT ENTRY
;	CARRY CLEAR - ACCOUNT FOUND
;	CARRY SET - ACCOUNT NOT FOUND
;-

ACCNT:	MOV	#ACCPT1,$ASUBR	; SET ADDRESS OF ACCEPTANCE ROUTINE
	CALL	$ASCAN		; SEARCH FOR ACCOUNT
	BCC	10$		; IF CC, ACCOUNT FOUND OK
	CALL	$AFCLS		; ERROR, CLOSE ACCOUNT FILE
	PRINT	#ERR4,#ERR4SZ	; PRINT ACCOUNT NOT FOUND MESSAGE
	SEC			; SET CARRY BIT TO INDICATE ERROR
10$:	RETURN			; AND RETURN TO CALLER
	.PAGE
	.SBTTL	ACCOUNT ACCEPTANCE ROUTINE #1
;+
; *** ACCPT1
;
;	THIS ROUTINE IS CALLED BY $ASCAN WHEN A PRIMARY ACCOUNT AS
;	ENTERED WITH OPTION INPUT IS BEING LOCATED WITHIN THE
;	ACCOUNT FILE.
;
;-
ACCPT1:	CMP	UIC,A.GRP(R0)	; GROUP CODES MATCH?
	BNE	10$		; IF NE NO
	CMP	UIC+2,A.GRP+2(R0) ; MAYBE
	BNE	10$		; IF NE NO
	CMP	UIC+4,A.MBR+1(R0) ; YES, MEMBER CODES MATCH?
	BNE	10$		; IF NE NO
	MOV	R0,ENTRY	; SAVE ENTRY POINTER
	TSTB	PSWBUF		; PASSWORD SPECIFIED?
	BEQ	7$		; IF EQ NO, THIS ACCOUNT MUST CHECK OUT THEN
	ADD	#A.PSWD,R0	; POINT TO A/C FILE PASSWORD
	MOV	#PSWBUF,R1	; AND OUR VERSION OF IT
	MOV	#6,R3		; SET LENGTH TO CHECK
5$:	CMPB	(R0)+,(R1)+	; DOES IT MATCH SO FAR?
	BNE	9$		; IF NE NO, SET CARRY AND EXIT
	DEC	R3		; ANY LEFT TO CHECK?
	BNE	5$		; IF NE YES, LOOP
	MOV	ENTRY,R0	; RESTORE R0
7$:	CLC			; PASSWORD CHECKS OUT
	RETURN			; RETURN TO $ASCAN
9$:	MOV	ENTRY,R0	; RESTORE R0
10$:	SEC			; SET CARRY BIT FOR NO MATCH
	RETURN			; AND RETURN TO $ASCAN
	.PAGE
	.SBTTL	ACCOUNT ACCEPTANCE ROUTINE #2
;+
; *** ACCPT2
;
;	THIS ROUTINE IS CALLED BY $ASCAN WHEN SEARCHING FOR AN ACCOUNT
;	WITH A SPECIFIC ACCOUNT NUMBER.
;
;-

ACCPT2:	MOV	A.ACNO(R0),R1	; GET ACCOUNT NUMBER
	BIC	#100000,R1	; CLEAR MASTER FLAG (IF SET)
	CMP	ACNO,R1		; DOES IT MATCH?
	BEQ	10$		; IF EQ YES
	SEC			; SET NO MATCH
10$:	RETURN			; RETURN TO $ASCAN
	.PAGE
	.SBTTL	ACCOUNT ACCEPTANCE ROUTINE #3
;+
; *** ACCPT3
;
;	THIS ROUTINE IS CALLED BY $ASCAN DURING THE "N" OPTION TO CHECK
;	THAT NO ACCOUNTS ARE CHAINED TO THE MASTER WHOSE STATUS WE ARE
;	TRYING TO DELETE.
;
;-

ACCPT3:	CMP	A.CHWD(R0),ACNO	; THIS A/C CHAINED TO THE MASTER?
	BEQ	10$		; IF EQ YES
	SEC			; NO, SET CARRY BIT
10$:	RETURN			;
	.PAGE
	.SBTTL	ROUTINE TO CHECK CHAIN LINKAGE
;+
; *** CHWCHK
;
;	THIS ROUTINE RETURNS A CARRY SET INDICATION IF THE CURRENT
;	ACCOUNT ENTRY IS CHAINED, AND A CARRY CLEAR INDICATION IF
;	IT IS NOT CHAINED. IT IS USED IN CIRCUMSTANCES WHERE AN OPTION
;	IS ILLEGAL IF APPLIED TO A CHAINED ACCOUNT.
;
;-

CHWCHK:	CLR	CHWD		; ZERO THE LINKAGE POINTER (FOR RECORDING)
	TST	A.CHWD(R0)	; DOES THE CHAIN WORD POINT ANYWHERE?
	BEQ	10$		; IF EQ A/C IS NOT CHAINED
	CALL	$AFCLS		; A/C IS CHAINED: CLOSE ACCOUNT FILE
	PRINT	#ERR8,#ERR8SZ	; ISSUE AN ERROR MESSAGE
	SEC			; SET THE CARRY BIT
10$:	RETURN			; AND RETURN TO THE CALLER
	.PAGE
	.SBTTL	ROUTINE TO READ A LINE FROM THE TERMINAL
;+
; *** IORVB  - READ A LINE FROM TERMINAL
; *** IORNE  - AS IORVB, BUT READ WITH NO ECHO
;
; OUTPUT:
;	R0 - BUFFER ADDRESS
;	R1 - ADDRESS OF TERMINATING CHARACTER
;-

IORVB:	MOV	#IO.RVB,R1	; SET READ VIRTUAL FUNCTION CODE
	BR	CM		; JOIN COMMON CODE
IORNE:	MOV	#IO.RNE,R1	; SET READ WITH NO ECHO
CM:	MOV	#DPBINP,R4	; GET DPB ADDRESS
	MOV	R1,Q.IOFN(R4)	; SET FUNCTION CODE
	MOV	#BUF,R0		; SET BUFFER ADDRESS
	MOV	R0,Q.IOPL(R4)	; SET BUFFER ADDRESS
	MOV	#F.LTXT,Q.IOPL+2(R4) ; SET BUFFER LENGTH TO READ
	DIR$	R4		; READ THE LINE
	MOV	R0,R1		; GET BUFFER ADDRESS
	ADD	IOSB+2,R1	; ADD NUMBER OF CHARACTERS READ
	MOVB	IOSB+1,(R1)	; STORE TERMINATOR
	CMPB	#IE.EOF,IOSB	; CTRL/Z TYPED?
	BNE	10$		; IF NE NO
	JMP	EXIT		; YES, JUMP TO EXIT ROUTINE
10$:	RETURN			;


	.END	$MNTEP