title FORMRG	routines to handle form and fields
;
;
; equates for assembly
;
INCLUDE RSOPT.INC
;
entry	stackp,stkptr,indptr,addbase,freest,nxfree,ckfree,chain,upper
entry	exit,resdsk,curdsk,setdsk,abort,spaces
entry	gtform,ckform,dsform,mkform,clused,fdused,rpname,copyright

;
; ARRAY
;
ext	copyhl,cmpde
ext	subde
ext	locahl		;locate string in array at HL
ext	linel0		;get line length into HL
ext	getans		;display message and get responce 
ext	puterr		;put error character into message

; RGEN

ext	xpret		;external program return
ext	fopen		;file open
ext	fmake		;extent creation
ext	eosdsk		;last disk used
ext	imdos		;imdos simulator
ext	dskset		;select disk drive
ext	defdma		;set default dma address
ext	keydes		;key descriptor block
ext	fldlns		;field length table
ext	decoff		;decimal offset table for edit masks
ext	fnameb,fname,fncnt ;report name

ext	array2		;field name table
ext	array3		;fields selected table
ext	array4		;count summary table
ext	array5		;other summary table
ext	fnames		;field name table
ext	nmflds		;number of fields in form
ext	slflds		;number of fields selected
ext	formdk		;name of file being reported
ext	itmpl5		;items per line, array 5
ext	linem4		;line mask, array 4
ext	snline		;summary name line
	IF KANA
ext	kocahl		;locate routine for KANA only
	ENDIF

	page 60
; RGMSG

ext	mstart		;message module length, memory resident portion
ext	ind1st,indlst	;message offset list start and end
ext	chainm,chname	;can't find program for chaining
ext	rptm01,rptm02
ext	rptm03,rptm04
ext	rptm05
ext	mxtype,mntype	;'MAX', 'MIN'
ext	ctflag		;flag to include count ('Y')
ext	pgflag,rpflag	;'P', 'R'
ext	rptx01,rptx02	;text for form image
ext	rptx03,rptx04
ext	rptx05,rptx06
ext	rptx07,rptx08
ext	frstcl		;first column to use in detail line
ext	abtms1,abtms2
ext	abtms3,abtms4
ext	abtms5
ext	dtamsg		;'DTA'
ext	intmsg		;'  (intermediate field)'
ext	msgdsk
ext	refile		;pointer to REDIT for chaining
ext	eddec1,eddec2	;edit mask characters for decimal point
ext	copym1,copym2	;copyright

; IOPACK/USER

ext	clears		;clear screen
ext	getif		;get input if waiting
ext	endcur		;position cursor at form end
ext	dsplay		;display message from cursor position in BC
ext	msgrsp		;display message and get responce
ext	readbf		;read line like CP/M call
ext	pbgmem		;end of program
ext	system		;system disk drive
ext	clrline		;clear lines
ext	wtline		;wait for line display
ext	coprit		;copyright message
	IF KANJI
ext 	knjtst		;test if byte in ACC is first of a KANJI character
ext	knjflg		;set when KANJI character input in IOPACK
	ENDIF

	page

nmdisk	equ 16		;number of disk drives allowed
maxkey	equ 9		;maximum number of key fields
namlen	equ 8
typlen	equ 3
fnamel	equ 11		;form name length
fnamet	equ fnamel+1	;total length
summl	equ 4		;summary block length

ctlb	equ 2
ctrlc	equ 3
cr	equ 0DH
ctls	equ 13H
ctrlz	equ 1AH
esc	equ 1BH

	IF HILITE
remvid	equ 7FH		;true for HIGHLIGHTING
fieldl	equ 32		;true for HIGHLIGHTING
	ENDIF
	IF ATEBIT
remvid	equ 0FFH	;true for 8 BIT CHAR SET
fieldl	equ 33		;true for 8 BIT CHAR SET
	ENDIF

cmdlin	equ 80H
deffcb	equ 5CH
chnfcb	equ 5CH
defext	equ 68H
defbuf	equ 80H
exchnr	equ defbuf+fnamet ;execute chain routine here

boot	equ 0
bdos	equ 5
bdosp	equ 6

coninf	equ 1
conrdy	equ 11
seldsk	equ 14
closef	equ 16
deletf	equ 19
readf	equ 20
writef	equ 21
renamf	equ 23
getdsk	equ 25
setdmf	equ 26

; FILE DEFINITION BLOCK

dforms	equ 0		;item number of forms count

ddtype	equ 2		;offset for type byte

dt.ovw	equ 1		;overwrite if output (internal use, not set in file)
dt.key	equ 2		;keyed
dt.ndx	equ 8		;write index if output, follow index order if input
;dt.upd	equ 8		;allow update if input (unused)
;dt.pre	equ 10H		;presorted if input (unused)
dt.mvf	equ 20H		;multi-volume
dt.app	equ 40H		;append if output
dt.out	equ 80H		;input = 0, output = 80H

ddmisc	equ 3		;offset for misc byte

dm.ent	equ 1		;enter names at run time
dm.def	equ 2		;use default name
dm.exp	equ 4		;exclusion expression present
dm.aim	equ 8		;file already in memory
;dm.soc	equ 10H		;NZ if sort order was changed (unused)

dddisk	equ 4		;offset for form disk
ddname	equ 5		;offset for form name
ddbuf	equ 13		;offset of number of buffers
ddbcon	equ 14		;end of constant portion

ddb	equ 40H		;flag for a ddb item
lpf	equ 0C0H	;flag for a loop item

ddsort	equ ddb+1	;item number for sort fields (2 bytes per field)
 ddsfld	equ lpf		;item number of sort field number
 ddsflg	equ lpf+1	;item number of sort flag
  ds.dsc equ 1		;descending
  ds.str equ 2		;string
 ddslen equ 2		;number of bytes

ddfnms	equ ddb+2	;item number of number of names (12 bytes per file)
 ddfdsk	equ lpf+2	;item number for file disk
  df.chd equ 80H	;change disks
 ddfnam	equ lpf+3	;item number for file name
 ddftyp	equ lpf+4	;item number for file type
 ddflen	equ 12		;number of bytes

ddexpl	equ ddb+3	;item number of exclusion expression length
;ddeexp	equ ddb+4	;item number for end file expression length (unused)
ddnflds	equ ddb+5	;item number for number of fields in form
 ddfuse	equ lpf+5	;item number for field is used code (internal use only)
 df.use	equ 1		; bit for is used (internal use only)
 dddlen	equ 1		; number of bytes per field (internal use only) 
 dd.int	equ 80H		; intermediate field

	page

; FIELD DEFINITION BLOCK

;fdlen	equ 2		;offset of field length
;fdaddr	equ 3		;form/equblk address (internal use only)
;fdcol	equ 3		;offset of column in form image
;fdline	equ 4		;offset of line in form image

;fdtype	equ 5		;offset of field type

ft.src	equ 3		;field source mask
ft.fil	equ 0		;file
ft.clc	equ 1		;calc
ft.inp	equ 2		;input
ft.coi	equ 3		;calc or input
ft.str	equ 4		;string calc
ft.out	equ 8		;output field
ft.equ	equ 40H		;field is equivalenced

;fdedit	equ 6		;offset of edit flags

fe.rj	equ 1		;right justified
fe.edm	equ 2		;edit mask
;fe.rmi	equ 4		;strip edit characters on input (unused)
;fe.rmo	equ 8		;strip edit characters on output (unused)
fe.cbd	equ 10H		;field is control break dependent
fe.pgd	equ 20H		;field is page dependent
fe.da	equ 80H		;decimal aligned

;fdpad	equ 7		;offset of pad character
;fdifil	equ 8		;offset of input file number
;fdifld	equ 9		;offset of input field number
;fdindx	equ 10		;offset of input index field if reference
;fdofil	equ 11		;offset of output file number
;fdofld	equ 12		;offset of output field number
;fdondx	equ 13		;offset of output index field if reference
;fdcbl	equ 14		;offset of control break level
;fdequ	equ 15		;offset of equivalent field
;fdbcon	equ 16		;length constant portion

;fdb	equ 80H		;flag for fdb item

;fdedw1	equ fdb+1	;item number of mask part I
;fdedw2	equ fdb+2	;item number of mask part I
;fdcexp	equ fdb+3	;item number of calculation expression length
;fdinp	equ fdb+3	;item number of input expression length (if no calc)
;fdclpc	equ fdb+4	;item number of UNLESS/THEN expression count
;fdclex	equ lpf+6	;item number of UNLESS expression
;fdctex	equ lpf+7	;item number of THEN expression
;fdclen	equ 2		;number of bytes to add/remove in maintaining the loop
;fdlexp	equ fdb+5	;item number of load expression length
;fdoexp	equ fdb+6	;item number of output expression length (unused)
;fdkexp	equ fdb+7	;item number of clear if expression
;fdname	equ fdb+8	;item number of field name

;
; datastar FDB equates
;
ds.nam	equ 40H		;datastar field is named
ds.dec	equ 20H		;datastar field is decimal aligned
ds.edw	equ 2		;edit word
ds.rng	equ 4		;range
ds.lst	equ 40H		;list verify
ds.int	equ 1		;intermediate field

dslen	equ 1		;offset to length
dsdec	equ 7		;decimal offset
dsedc	equ 16		;edit word

flnmsk	equ 3FH		;field name length mask
minfdb	equ 13		;minimum length for an fdb

;
; flags for summaries requested
;
s.cnt	equ 1
s.tot	equ 10H
s.ave	equ 20H
;
; arithmetic operation/function codes
;
c.num	equ 0FFH	;number
c.fcn	equ 0FDH	;function
c.add	equ 0F6H	;add
c.div	equ 0F3H	;divide
c.lp	equ 0F1H	;left paren
c.rp	equ 0F0H	;right paren
c.cma	equ 0EFH	;comma

f.max	equ 2		;maximum
f.min	equ 3		;minimum
f.pag	equ 5		;page function
;
; other
;
paglen	equ 4		;length of page field
cntlen	equ 5		;length of count field
fcnlen	equ 3		;function name length
idlen	equ fcnlen+2	;length of summary identifier
totlen	equ cntlen	;length to add if field is totaled
spacing	equ 2		;space between items in detail line
exlinm	equ 5		;line number for extra field for control breaks
numexf	equ 3		;number of extra fields (mo, day, year)
arraye	equ 0FFH	;array end marker
cbchar	equ 1DH		;control break character
nparms	equ 16		;number of report parameters
hole	equ 5FH		;hole in summary array
mxflds	equ 250		;maximum number of fields

	page
;
; set stack pointer
;
stackp:	lhld mstart	;message module length
	lxi d,mstart	;message location
	dad d
	xchg
	lhld pbgmem	;program end pointer
	call cmpde
	jc stckp1	;jif user set end
	xchg
stckp1:	lxi d,100	;use 100 decimal for stack
	dad d
	shld stkptr	;stack pointer start
	pop d		;our return
	sphl		;switch stacks
	push d		;restore return
	mvi c,getdsk
	call imdos	;get current disk
	sta entdsk	;set disk on entry
	call setdsk	;set current disk
	call defdma	;set default dma address
	ret
;
; set current disk
;
setdsk:	sta curdsk	;to restore on exit
	mov e,a
	adi 'A'
	sta msgdsk	;for messages
	mvi c,seldsk
	call imdos	;tell bdos what we did
	ret

;
; display copyright
;
copyright:
	call onesec	;wait a second
	lxi h,copyl
start1:	mov e,m		;message address
	inx h
	mov d,m
	inx h
	mov c,m		;screen address
	inx h
	mov b,m
	inx h
	mov a,e
	ora d
	jz wtline	;jif end list
	xchg
	call dsplay
	xchg
	jmp start1
;
copyl:	dw coprit,0008H
	dw copym1,0100H
	dw copym2,0600H
	dw 0
;
onesec:	lxi h,0
ones1:	xthl
	xthl
	inx h
	mov a,h
	ora l
	jnz ones1
	ret
;
;  HL = pointer to offset from mstart-100H of nessage
;
indptr:	push d
	push psw
	lxi d,ind1st
	dcx d
	call cmpde
	jnc indpt1	;not indirect
	lxi d,indlst
	call cmpde
	jc indpt1	;not indirect
	mov e,m
	inx h
	mov d,m
	xchg
	call addbase
indpt1:	pop psw
	pop d
	ret
	
;
; add message file base	to offset in HL
;
addbas:	push d
	lxi d,mstart	;message base
	dcr d		;assemled starting at 100H
	dad d
	pop d
	ret

	page
;****************************************
;
; chain next program
;  HL = program name pointer
;
;****************************************
;
chain:	push psw	;save chain flag
	lxi d,chnfcb	;chain fcb
	push d
	mvi b,0CH
	call copyhl	;copy to fcb
	xra a
	stax d		;clear extent
	pop d
	call chopen	;open the program file
	call endcur	;restore terminal
	call getif	;get input character if one is waiting
	cpi ctrlc
	jz boot		;abort
	call dskset	;select disk and clear first byte of FCB
	lxi h,100H
	pop b		;chain flag
	sphl		;set stack pointer
	push b
	lda curdsk
	mov c,a
	push b		;save current disk
	lxi h,fncnt	;form name count
	lxi d,defbuf
	mvi b,fnamet	;count + form name
	call copyhl	;move form name
	lxi h,chainp
;
; routine to move stuff @HL to exchnr and execute it there
;  with DE = 100H and HL = @BDOSP
;
chaine:	lxi d,exchnr
	mvi b,78H-fnamet;don't overwrite stack
	call copyhl	;move program
	lxi h,100h	;program start
	xchg
	lhld bdosp
	jmp exchnr	;execute chain program
;
chksys:	lda system
chkdsk:	call upper
	sui 'A'
	cpi nmdisk
	inr a
	ret
;
; open file for chaining
;
chopen:	call fopen	;try on current disk
	rz		;success
	call chksys
	jnc chopn1	;not assigned
chopn0:	stax d
	call fopen	;try again with system disk
	rz		;exit to system if not found
chopn1:	ldax d
	ora a
	jnz chopn2
	lda curdsk
	inr a
chopn2:	adi 'A'-1
	sta msgdsk	;set disk drive for message
	push d
	inx d
	lxi h,chname
	call indptr
	xchg
chopn3:	mov a,m		;move name to error message
	stax d
	inx h
	inx d
	sui ' '
	jnz chopn3
	dcx d
	stax d		;mark end
	call clears
	lxi h,chainm
	lxi b,700H	;line 7, accept all answers
	call msgrsp
	pop d		;restore fcb pointer
	call chkdsk
	jc chopn0
exit:	call endcur
	call resdsk
	jmp boot	

	page
;
; program to chain next program
;
;  assembled here, but resides at exchnr (8BH) for execution
;
chainp:	push d
	mvi c,conrdy
	call bdos
	ora a
	mvi c,coninf
	cnz bdos	;get character if ready
	cpi ctrlc
	jz boot		;abort on ctrl-c
	pop d
	push d		;some BDOS's clobber
	mvi c,setdmf
	call bdos	;set address
	lxi d,chnfcb
	mvi c,readf
	call bdos	;read the sector
	pop d		;restore address
	lxi h,80H
	dad d
	xchg		;point next sector
	ora a
	jz exchnr	;loop to routine start
	cpi 1
	jnz boot	;boot if error
	lxi d,chnfcb
	mvi c,closef
	call bdos	;close file for MP/M
	pop b		;logged drive
	pop psw		;chain flag
	jmp xpret	;start up for chain

	page
;****************************************
;
; 	get form name
;
;****************************************
gtfrm0:	push psw
	call puterr	;put character into message buffer
	pop psw
	lxi h,rptm02
	jz gtfr00	;jif not entered
	lxi h,rptm05
	jm gtfr00	;jif bad disk drive
	cpi ctrlc
	jz exit
	lxi h,rptm04	;bad character in file name
gtfr00:	lxi b,100H
	call msgrsp
	cpi ctrlc
	jz exit
	cpi esc
	jnz gtfr00
gtform:	lxi h,cmdline
	mov a,m	
	ora a
	jnz gtfrm3	;jif name entered
gtfrm1:	lxi h,rptm01
	lxi b,900H	;line 9
	call dsplay
	lxi h,fnameb
	call readbf	;get input line
	mvi b,0
	mvi a,1
	call clrline
gtfrm2:	lxi h,fncnt	;point number bytes entered
	lxi d,rptfcb
	call vrname	;verify name and move to rptfcb
	jc gtfrm0	;jif illegal
	xra a
	stax d		;clear extent
	ret
;
; copy name on command line into fnameb
;
gtfrm3:	mvi b,0
	mvi a,1
	call clrline
	mov b,m
	mvi m,0		;in case illegal
gtfrm4:	dcr b
	jm gtfrm1	;nothing but spaces
	inx h
	mov a,m
	cpi ' '
	jz gtfrm4
	inr b
	mov a,b
	cpi 12
	jnc gtfrm1	;too many characters
	lxi d,fncnt
	stax d
	inx d
	call copyhl
	xra a
	stax d
	jmp gtfrm2
;
; verify name and move to DE
;  HL = number of bytes, followed by name
;
; returns 
;	 CY set if illegal (test first)
;	 Z also set if empty, just disk drive or too many characters
;	 M also set if bad disk drive
;	 C register has last character
;
vrname:	mov a,m		;count
	ora a
	stc
	rz		;empty
	xra a
	stax d		;assume logged disk
	inx h		;point name
	inx h		;point ':' if there
	mov a,m		;get it
	dcx h
 	cpi ':'
	jnz vrnam1	;jif current disk
	call gtbyte	;get disk
	call chkdsk
	stax d		;set disk drive
	mvi a,0FFH	;for bad disk drive
	jnc vrnam3	;jif disk drive too high
	inx h		;skip disk
	inx h		;skip ':'
vrnam1:	inx d
	mov a,m
	ora a
	stc
	rz		;can't have just disk drive
	mvi b,8		;8 bytes in file name
vrnam2:	call gtbyte	;convert to upper, set Z if empty, CY if illegal
	jc vrnam3
	call vrnam4	;replace with space if empty/illegal
	stax d
	inx d
	dcr b
	jnz vrnam2
	mov a,m
	ora a
	rz
	mvi a,0
vrnam3:	ora a		;set Z or M flag
	stc		;set CY
	ret

;
vrnam4:	mvi a,' '
	rz
	rc
	mov a,m
	inx h
	ret

	page
;
; get next byte
;  convert to upper
;  set Z if empty
;  set CY if illegal
;
gtbyte:	mov a,m
	mov c,a
	ora a
	rz		;empty
  	IF KANJI
	call knjtst	;is it the first byte of a Kanji?
	jnc gtbyt2	;jif not
	mvi a,1		
	sta knjflg	;set the KANJI flag
	ora a		;ensure minus flag not set
	stc		;set carry 
	ret
gtbyt2:
	ENDIF
	cpi '0'
	rc		;0-2FH illegal
	call upper	;convert to upper case

	IF KANA
	cpi 0A0H	;test if less than first KANA char
	jc gtbyt1	;j if not KANA
	cpi 0E0H	;test if greater than last KANA char
	cmc		;compliment cy to mean invalid
	rc		;0E0H - 0FFH invalid
gtbyt1:
	ENDIF

	mov m,a
	cpi '['
	cmc
	rc		;5BH-60H, 7B-7FH illegal 
	sui ':'
	cpi 'A'-':'
	mov a,m		;restore
	rc		;3AH-40H illegal :;<=>?@
	ora a		;clear Z
	ret			
;
; covert to upper case
;
upper:	
	IF KANA
	cpi 7FH		;if not ASCII don't convert
	rnc
	ENDIF

	cpi 60H
	rc
	ani 5FH		;convert to upper
	ret
;
; reset current disk for exit
;
resdsk:	mvi c,seldsk
	lda entdsk
	sta curdsk
	mov e,a
	call imdos
	call defdma
	ret

	page
;****************************************
;
; 	check infostar form present
;
;****************************************

ckform:	call rptype
	call rdopen	;open the file
	jnz ckfrm1	;jif file not found
	call rdclose
	lxi h,rptm03
	mvi b,1
	call getans	;see if he wants to chain redit or retype
	jz clears	;retype after clearing screen
	cpi 2		;second answer = ^C
	jz exit
	lxi h,refile
	xra a
	jmp chain	;chain redit
;
; see if enough space left on disk
;
ckfrm1:	call putype	;return DE = FCB
	db '$$$'
	call delfile	;remove old copy
	call makfile	;make file
	call clsfile	;write last sector and close file (returns DE = FCB)
delfil:	mvi c,deletf
	call imdos	;now get rid of it
	ori 0FFH	;return NZ => ok to proceed
	ret
;
; make directory entry for file
;
makfil:	lxi h,defbuf
	shld bufptr	;init buffer pointer
	call fmake
	rz
	lxi d,abtms4
	jmp abort
;
rptype:	lxi d,rptfcb
	call putype
	db 'RPT'
	ret
;
; put file type into FCB
;
putype:	xthl		;get file type pointer
	push d
	push b
	xchg
	lxi b,namlen+1
	dad b		;point file type in FCB
	xchg
	mvi b,typlen
	call copyhl	;copy file type to FCB
	xra a
	stax d		;clear extent
	pop b
	pop d
	xthl
	ret
;
; open form file for form imput
;  DE = FCB
;
rdopen:	call fopen	;open the file
	lxi h,defbuf+80H
	shld bufptr
	lxi h,cmdline
	mvi m,0		;in case file wasn't found
	ret
;
rdclos:	lxi d,deffcb
	mvi c,closef
	call imdos	;now close it back up
	ret

	page
;****************************************
;
; 	read datastar form
;	 HL = name pointer (disk,name)
;
;****************************************


dsform:	call defdma	;set dma address
	lxi d,deffcb
	mvi b,9
	call copyhl	;copy to default FCB
	call frmtyp	;put type
	call rdopen	;open the file
	rnz		;not found
	lxi h,0
	dad sp
	shld callsp	;save for error
	lhld fldlns
	shld flnptr	;set pointer
	lhld decoff
	shld decptr	;set pointer
	lhld nxfree	;where to put
	call skpnam	;skip file name
	call rdkeys	;read key descriptor block
	call skpimg	;skip form image
	call dsblks	;read field names
	shld nxfree	;reset next free space
	call rdclose	;close it back up
	xra a
	ret
;
frmtyp:	lxi d,deffcb
	call putype
	db 'DEF'
	ret
;
; skip name
;
skpnam:	push h
	lxi b,8
	call gtdata
	pop h
	ret
;
; read key descriptor block
;  HL = where to put
;
rdkeys:	push h
	lhld keydes	;key descriptor
	lxi b,1
	call gtdata	;get number of key fields
	add a
	mov c,a
	cnz gtdata
	lhld keydes
	mov a,m
	cpi 10
	jc rdkey1
	mvi m,maxkey	;replace with maximum if too many
rdkey1:	pop h
	ret
;
; skip form image
;
skpimg:	push h
	lxi b,4
	call gtdata	;get data from file
	pop h
	push h
	inx h
	inx h
	mov b,m		;number of lines
	inx h
	mov c,m
skpim1:	pop h
	push h
	push b
	mvi b,0
	call gtdata
	pop b
	dcr b
	jnz skpim1
	pop h
	ret
;
; read Datastar field names
;  HL points to free space start
;
dsblks:	lxi b,2		;it's still two
	call gtdata	;read nunber of fdbs and zero byte
	dcx h		;skip zero byte
dsblk1:	push h		;save start
	call rdsblk	;read ds block
	pop h
	rz		;done
	push h		;save destination
	call pntnam	;set HL to name pointer, also set byte @flnptr & decptr
	pop d		;get destination into DE
	ora m		;add intflg (80H) to  name length
	mov m,a		;put intermediate flag into name table
	ani flnmsk	;now get rid of it
	mov b,a		;number of bytes
	inr b		;one for length byte
	call copyhl	;move name length and name
	xchg
	jmp dsblk1
;
; read DS block
;
rdsblk:	lxi b,1
	push h
	call gtdata	;read first byte of offset
	ora a
	inx b
	cnz gtdata	;read second byte of offset
	xthl
	call dsblen	;get ds block length into BC
	pop h
	mov a,b
	ora c
	rz		;rif done
	dcx b		;remove offset bytes from count
	dcx b
	call gtdata	;read rest of FDB
	ori 0FFH	;say there's more
	ret
;
; get DS block length into BC
;
dsblen:	mov c,m
	mov a,c
	ora a
	rz
	cpi minfdb
	rnc
	mov b,a
	inx h
	mov c,m
	ret
;
; point to name
;
pntnam:	mov a,m
	cpi minfdb
	jnc pntnm1
	inx h		;skip xtra byte of offset
pntnm1:	lxi b,dsdec	;offset to decimal offset
	dad b
	mov e,m		;decimal offset
	dcx h
	mov d,m		;edit byte
	dcx h
	mov a,m		;type byte
	ani ds.int
	rrc		;put flag at 80H
	push psw	;save type byte
	dcx h
	mov a,m		;control byte
	ani ds.dec	;check for decimal offset
	jnz pntnm2
	mvi e,0FFH	;flag for not there
pntnm2:	mov a,m		;save control byte
	dcx h
	dcx h
	dcx h
	mov c,m		;field length
	push h
	lhld flnptr	;field length pointer
	mov m,c		;put into table
	inx h
	shld flnptr
	lhld decptr	;put decimal offset into table
	mov m,e
	inx h
	shld decptr
	pop h
	ani ds.nam	;check for name
	jz pntnm3
	mvi a,ds.edw
	call pntnm4	;add for edit mask
	mvi a,ds.rng
	call pntnm4	;add for range
	mvi c,6		;1/2 file name length
	mvi a,ds.lst
	call pntnm4	;add for file name
	mvi c,dsedc-dslen
	dad b		;this should point to calc
	mov c,m
	inx h		;skip calc length
	dad b		;skip calc
	pop psw		;restore intermediate flag
	ret
;
pntnm3:	lxi h,noname
	pop psw		;intermediate flag
	ret
;
pntnm4:	ana d
	rz
	dad b
	dad b
	ret
;
; get data from file
;
; including 
;  make sure BC + HL < bdos
;  make sure no eof is encountered
;
gtdata:	push d
	push h		;save data destination ptr
	call ckfree
	pop d		;restore destination pointer
	lhld bufptr
gtdat1:	mov a,h
	dcr a		;test for end of buffer
	cz rdbuff	;read if empty
	dcx b
	mov a,b
	ora c
	mov a,m
	stax d		;mov from buffer
	inx h
	inx d
	jnz gtdat1
	shld bufptr
	xchg
	pop d
	ret
;
; read buffer from disk
;
rdbuff:	push d
	push b
	mvi c,readf
	lxi d,deffcb
	call imdos
	pop b
	pop d
	lxi h,defbuf
	rz		;return if no error
	lhld callsp
	sphl
	lxi h,abtms1
	stc
	ret		;return NZ if error
;
abort:	lda eosdsk
	adi 'A'
	sta msgdsk
abort1:	xchg
	lxi b,100H+cr
	call msgrsp
	jmp exit
;
badfdb:	lxi d,abtms2	;Fatal progam error
	jmp abort1
;
memerr:	lxi d,abtms3	;Insufficient memory
	jmp abort1
;
; check enough free space
;
ckfree:	dad b		;do the test first
	xchg
	call negde
	lhld bdos+1
	dcr h
	dad d
	rc
;
; out of memory
;
	jmp memerr

	page
;
; make form from specifications and write it to the disk
;
mkform:	push h		;save chain program name address
	call mkinit	;initialize the process
	call mcbl	;make control break level block
	call mforms	;make file block at FORMS
	call mfields	;make fields
	call mimage	;make form image
	call wtform	;now write it
	pop h
	ret
;
; initialize the form making
;
mkinit:	lhld nxfree
	xchg
	lhld bdosp
	call subde	;get number of bytes left
	shld ctfree	;and set it
	lhld array2
mkin1:	mov a,m
	cpi arraye
	rz
	ani remvid	;clear high bit from name array
	mov m,a
	inx h
	jmp mkin1
;
; make control break level block
;
mcbl:	call allkey	;allocate key descriptor block
	shld cbldes	;set pointer
	mov a,m
	sta cbreaks	;set number of control breaks
	mvi c,numexf	;field number of first control break field
mcbl2:	ora a
	rz
	inx h		;point field
	mov m,c		;insert field number
	inx h
	inr c
	dcr a
	jmp mcbl2

	page
;
; allocate key descriptor block
;
allkey:	lhld nxfree
	push h
	lhld keydes
	mov a,m
	add a
	inr a		;key descriptor length
	call putblk
	pop h
	mov a,m
	ora a
	rz
	push h
allky1:	inx h		;point field
	inr m		;change field number to Infostar field number
	inx h
	dcr a
	jnz allky1
	pop h
	ret
;
; make file block at FORMS
;
mforms:	lhld nxfree
	shld forms	;set pointer to file block
	call movnam	;move report name from fname to filen
	lxi h,filebk
	mvi a,blkln1
	call putblk	;put into memory
	lxi h,formdk
	mvi a,namlen+1
	call putblk
	mvi a,7		;for 8 buffers
	call ptchar	;ddbuf
	mvi c,1		;add 1 to all field numbers
	call allkey	;allocate block and put keydes into it
	mvi a,1
	call ptchar	;1 data file
	lxi h,formdk
	mvi a,namlen+1
	call putblk	;put disk, file name
	lxi h,dtamsg	;'DTA',0,0
	mvi a,5
	call putblk
	lhld fldlns	;field length table
	xchg
	lhld fnames	;field names
	mov a,m
	mov b,a
	call ptchar	;number of data fields in file
	inx h		;point first name length

mform1:	mov a,m		;get name length
	inx h
	mov c,a
	call ptchar	;put name length
	mov a,c
	ani flnmsk
	cnz ptblk0	;put name
	ldax d
	call ptchar	;field length
	inx d
	dcr b
	jnz mform1
	mvi a,3
	call ptzero
	lhld forms
	inx h		;point form length
	xchg
	lhld nxfree
	call subde
	xchg
	mov m,e		;put down length
	inx h
	mov m,d
	mvi a,2
	call ptzero
	mvi a,0FFH
	call ptchar
	ret
;
; move report name from fname for filen
;
movnam:	lxi h,fname
	lxi d,filen
	mvi b,namlen
mvnam1:	mov a,m
	inx h
	ora a
	jnz mvnam2	;jif don't need to pad with spaces
	mvi a,' '
	dcx h
mvnam2:	stax d
	inx d
	dcr b
	jnz mvnam1
	ret

	page
;
; make field definition blocks
;
mfield:	lhld nxfree
	shld fields	;save pointer
	call mdatef	;make date fields
	call mxtraf	;make extra fields for selected control breaks
	call mfilef	;make fields derived from the file
	call msummf	;make summary fields
	mvi a,2
	call ptzero	;last field marker
	ret
;
; make date fields
;
mdatef:	call clused
	sui 8		;length of date string
	rar		;center
	sta mocol
	adi 3
	sta daycol
	adi 3
	sta yrcol
	lxi h,datebk	;date block
	mvi a,blkln3
	call putblk	;put first three fields for date block
	ret

	page
;
; make extra fields for selected control breaks
;  FDLEN = length of keyfield
;  FDCOL = summary name length + 6
;  FDLINE = current line +1
;
mxtraf:	mvi a,exlinm	;extra line number
	sta fdline	;set starting line number
	lhld keydes	;key descriptor block for file
	mov a,m		;count
	ora a
	rz		;don't have to make any
	mov b,a
	mvi c,0		;kepp summary number here
mxtrf1:	call nxline	;empty line
	push b		;save current count, total
	mov a,c
	inr a
	sta fdcbl	;put control break level
	dcr a
	inx h		;point field number
	mov b,m		;field number
	inx h
	mov c,m		;field length
	call mxtrf3	;for summary in ACC, get summary name length into ACC
	sta fdcol
	push h
	mov a,c		;use field length as number of columns needed
	mvi e,6		;offset to next
	lxi h,nofld
	call adffdb	;make FDB
	call nxline
	call nxline
	pop h
mxtrf2:	pop b
	inr c
	dcr b
	jnz mxtrf1
	xra a
	sta fdcbl
	ret
;
; for summary number in ACC
;  get name length into ACC
;
mxtrf3:	push h
	push d
	lhld linem4
	mov e,a
	mvi d,0
	dad d
	mov a,m
	pop d
	pop h
	ret	

	page
;
; check to see if summary in ACC/B is used
;  returns Z set if no
;  	 ACC with bits set according to which summaries are used
;
cbused:	mov a,b
	dcr a
ckused:	push h
	push d
	push b
	call ptsumm	;point to summary array for number in ACC
	lda ctflag	;symbol from message file for include count
	cmp m
	mvi c,0		;get result here
	jnz ckuse1
	mvi c,s.cnt
	call fduse4	;add to total
ckuse1:	dad d		;point next line
	dcr b
	jz ckuse4	;jif done
	push h
	push d
	mvi d,s.tot	;bit to set
	xchg
ckuse2:	ldax d
	cpi hole
	jz ckuse3
	mov a,c
	ora h
	mov c,a
	call fduse3	;add to fldcnt for fdused
ckuse3:	dad h
	inx d
	jnc ckuse2
	pop d
	pop h
	jmp ckuse1
;
ckuse4:	mov a,c
	pop b
	pop d
	pop h
	ora a
	ret

	page
;
; count number of fields used so far
;  return CY set if more than mxflds
;
fdused:	lda slflds
	ora a
	rz
	push b
	mov c,a
	lda itmpl5	;number of summaries
	mov b,a
	inr a		;less one for page, report, plus three date fields
	add c
	sta fldcnt	;count fields used here
fduse1:	call cbused	;add up fields needed
	call fduse2	;add extra one if wants average without count or page
	dcr b
	jnz fduse1
	pop b
	lda fldcnt
	cpi mxflds+1
	cmc		;set CY if too many
	ret
;
; add 1 to count if have average without count or any page summary
;  ACC = summaries used
;   B  = 2 if doing page summary
;
fduse2:	ora a
	rz		;no summaries
	mov c,a		;save
	mov a,b
	cpi 2
	cz fduse4	;add extra for page summary
	mov a,c
	ani s.cnt
	rnz		;ok if count selected
	mov a,c
	ani s.ave
	cnz fduse4	;add extra one to count if average
	ret
;
; add one to count for selected summary
;  also, add extra one to count if have average without total
;   H = summary being done
;   DE= summary array pointer
;
fduse3:	mov a,h
	ani s.ave
	jz fduse4	;jif not doing average
	dcx d		;point back to total
	ldax d
	cpi hole
	inx d
	cz fduse4	;add extra one for average without total
fduse4:	lda fldcnt
	inr a
	rz
	sta fldcnt
	ret

	page
;
; point to summary array for summary number in ACC
;  returns HL = array pointer
;	   DE = line length
;	    B = number of lines in array
;
ptsumm:	mov c,a		;number to skip
	lxi h,itmpl5
	call linel0	;get line length into HL
	xchg
	lhld array4	;array start
	lda slflds
	mov b,a
	inr b		;count
	push d
	lxi d,summl
	mov a,c
	call pentr0	;skip to array column
	pop d
	ret
;
; make fields derived from the file
;
mfilef:	lhld fields
	mov a,m
	sta fstfld	;save first field number
	lda frstcl
	sta fdcol
	lhld array3	;name start
	call nxline	;start a new line
	mvi d,0		;line number in array 5 (summary array)
mfile1:	call fldlen	;get number of cols needed into ACC, field len -> C
			;field number into B
	call adffdb	;add field to FDBs
	inr d		;field number
	lxi b,fieldl	;field name length
	dad b
	mov a,m
	cpi arraye
	jnz mfile1
	ret
;
; get field length etc.
;  HL = field name pointer
;   D = item number in summary array
;
; returns:
;  E = field offset
;  B = field number in input file
;  C = field length
; ACC= total number of columns needed
;
fldlen:	push h		;save field name pointer
	push d		;save line number in summary array
	call gtfnum	;get field number into DE
	lhld fldlns	;field length table
	dad d		;point field length
	mov c,m		;actual field length
	mov b,a		;save field number
	pop d		;get item number in summary array
	pop h		;field name pointer
	call fldoff	;get field offset into E
	call gnamln	;get name length into ACC
	cmp c
	rnc		;number of columns needed is max(name, field length)
	mov a,c
	ret
;
; for field name pointer in HL
;  return field number in file in ACC, DE
;
gtfnum:	xchg		;name pointer -> HL
	lhld array2	;input file field names
	mvi a,fieldl	;item length
	IF HILITE
	call locahl	;locate in array, return ACC = item number
	ELSE
	call kocahl	;locate in array, return ACC = item number (KANA)
	ENDIF
	mov e,a
	mvi d,0
	ret
;
; for line number in D, get field offset into E:
;	spacing between fields
;	plus totlen if field is totaled anywhere
;	
fldoff:	push h
	push d
	push b
	lxi h,itmpl5
	call linel0	;get line length into HL
	mov a,d
	xchg
	lhld array5	;summary array
	call pentr0	;point line in array
	lda itmpl5
	mov d,a		;count
fldof1:	mov a,m
	cpi hole
	mvi a,totlen+spacing
	jnz fldof2
	inx h
	inx h
	inx h
	inx h
	dcr d
	jnz fldof1
	mvi a,spacing
fldof2:	pop b
	pop d
	pop h
	mov e,a
	ret	
;
; get number of columns used into ACC
;
clused:	lda slflds	;number of selected fields
	ora a
	rz		;no columns
	push h
	push d
	push b
	lhld array3	;selected array
	mov b,a		;count
	lda frstcl
	mov c,a		;add up columns used here
	mvi d,0		;line number in summary array
cluse1:	push b		;routine returns goodies in BC that I don't want
	call fldlen	;return length in ACC, offset in E, B = -1 if not found
	inr b		;set Z if not found
	lxi b,fieldl
	dad b		;point next field name
	pop b
	jz cluse3
	add e		;add offset
	jc cluse2	;jif overflow
	add c		;add into total
	jc cluse2	;jif overflow
	mov c,a
cluse3:	inr d		;line number in summary array
	dcr b		;count
	jnz cluse1
cluse2:	mov a,c
	pop b
	pop d
	pop h
	ret
;
; add FDB to end of FDBs generated so far
;   (located at nxfree)
; HL = field name pointer
;  E = offset
;  B = field number in input file
;  C = field length
; ACC= total number of columns needed for field
;
adffdb:	push h
	push d
	push b
	push h		;save name pointer
	mov d,a		;save number of columns needed
	mov a,b
	inr a
	sta fdifld	;set input file number
	mov a,c
	sta fdlen	;set field length
	lxi h,fdcol
	mov a,m
	add e
	mov m,a		;add spacing
	pop h		;restore name pointer
	push d		;save number of columns to next field
	call gnamln	;get name length into ACC
	xchg		;save name pointer in DE
	sta fdname	;put into block
	mov b,a
	lxi h,fldblk
	mvi c,blkln4
	call addfdb	;allocate block and move
	lxi h,fdcol
	pop d
	mov a,d		;number of columns
	add m
	mov m,a		;new col
	pop b
	pop d
	pop h
	ret
;
; get name length into ACC
;
gnamln:	push h
	push d
	lxi d,fieldl
	dad d
gnmln1:	dcx h
	mov a,m
	cpi ' '
	jnz gnmln2
	dcr e
	jnz gnmln1
gnmln2:	mov a,e
	pop d
	pop h
	ret
;
; new line in form
;
nxline:	push h
	lxi h,fdline
	inr m		;next line
	pop h
	ret
;
; locate field in array2
;
lfield:	lhld array2
	call pentry	;point to entry in array
	mov a,m
	ora a
	ret
;
; make summary fields
;
msummf:	lhld keydes
	mov a,m
	mov b,a		;number of control breaks
	mov c,a
	ora a
	jz msumm2
msumm1:	call cbused	;set NZ if any summary requested
	cnz mksumm	;make summary number in B
	dcr b
	jnz msumm1
msumm2:	mov b,c
	inr b
	inr b
	call cbused	;check for page summaries requested
	cnz mkrpt	;make report summaries
	dcr b
	call cbused
	cnz mkpage	;make page summaries
	ret
;
; make summaries for summary number in B
;
mkpage:	call mksumm	;make summaries
	call nxline	;4 blank lines at page end
	call nxline
	call nxline
	call nxline
	ret
;
mkrpt:
mksumm:	push b
	push psw	;save summaries requested
	call nxline
	call nxline	;move to count line of summary
	mov a,b		;summary number
	dcr a
	cmp c
	cz mpagec	;if doing page line, put in field for page count
	lda fdline
	sta svline	;set total line number
	pop psw
	ani s.cnt+s.ave	;see if count needed
	cnz mk1cnt	;make count field for summary number in B
	push b
	mov a,b
	dcr a
	call ptsumm	;get HL = array pointer, DE = line length, B = count
	xchg
	shld lineln	;save line length
	dad d		;skip count summary
	dcr b
	mov d,b		;count
	mvi e,0		;keep field number here
	pop b
mksmm1:	push h		;save 4 byte block start
	lda svline
	sta fdline
	call nxline
	call nxline	;point total line
	mov a,m
	cpi hole
	cnz mk1tot
	inx h
	call nxline
	mov a,m
	cpi hole
	cnz mk1ave
	inx h
	call nxline
	mov a,m
	cpi hole
	cnz mk1max
	inx h
	call nxline
	mov a,m
	cpi hole
	cnz mk1min
	lhld lineln
	xchg
	xthl
	dad d		;skip to next summary block
	pop d
	inr e
	dcr d
	jnz mksmm1
	call nxline
	pop b
	ret
;
; make count field for page
;
mpagec:	push b
	mvi a,0FFh	;column not known
	sta fdcol
	mvi a,paglen
	sta fdlen
	mov a,b
	call getnam	;name length -> ACC, ptr -> HL
	xchg
	mov b,a
	adi 2
	sta pgname
	lxi h,pagblk
	mvi c,blkln5
	call addfdb
	pop b
	ret
;
; make count field for summary number in B, number of control break fields in C
;  if count was not selected, bump line number for non-printing line
;
mk1cnt:	push b
	ani s.cnt
	mvi a,0FFH	;assume count requested and column not known
	jnz mkcnt1	;jif count requested
	call nxline	;put in next line if not requested (non-printing)
	mvi a,3		;put in col 3
mkcnt1:	sta fdcol
	mvi a,cntlen
	sta fdlen
	lhld fields
	mov a,m
	sta avfld2	;set field number for average
	sta ctfld	;and field for calc
	call getclr	;get clear on code as function of B and C
	sta ctclr
	mov a,b
	call getnam	;get name pointer into HL, name length into ACC
	xchg		;save name pointer
	mov b,a		;save name length
	adi 2
	sta ctname	;set name length
	mvi c,blkln6	;block length
	lxi h,cntblk
	call addfdb	;add fdb
	pop b
	ret
;
; make 1 total field
;  HL = summary array pointer
;   E = field number
;   B = summary number
;   C = number of control break fields
;
mk1tot:	inx h
	mov a,m		;get flag for average
	dcx h
	cpi hole
	rnz		;if average, put total field in then
mkatot:	push h
	push d
	push b
	lhld fields
	mov a,m		;field number
	sta ttfld1	;set field number in calc
	call getclr	;get clear flag
	sta ttclr
	call getctl	;get print control code
	sta ttctl	;put into name
	mvi d,totlen	;amount to add to field length
	call gtbas1	;get base field stuff
	sta ttname	;total field name length
	mov a,c		;base field number
	sta ttfld2	;set field number in calc
	lxi h,totblk
	mvi c,blkln7
	call addfd0	;add fdb
	pop b
	pop d
	pop h
	ret
;
; get base field parameters and set fdlen, fdcol
;  E = selected field number
;
; returns with basdec set and
;         DE = base field name
;	   C = base field number
;	   B = base field name length
;	 ACC = summary field name length
;
gtbase:	mvi d,0		;summary is same length as base field
gtbas1:	mov a,e		;number in array3
	lhld array3
	push d
	call pentry	;get name pointer
	call gtfnum	;get field number in file into DE
	lhld decoff
	dad d		;point decimal offset
	mov a,m
	pop d
	cpi 0FFH
	jz gtbas2
	add d		;if decimal offset present, add extra length for TOT
gtbas2:	sta basdec
	lda fstfld	;first file field number
	add e
	mov c,a		;save base field number to return
	call fndfld	;locate field
	inx h
	inx h		;point field length
	mov a,m
	add d		;add extra length
	sta fdlen
	inx h		;point field column
	mov a,m
	sub d		;change column
	sta fdcol
	inx h
	inx h
	inx h
	mov a,m
	ori fe.rj	;make right justified since used in calculation
	mov m,a
	lxi d,fdname-fldblk-1
	dad d		;point name length
	mov a,m
	inx h		;point name
	xchg
	mov b,a		;to return
	adi idlen	;sb 5
	ret
;
; make 1 average field and 1 total field
;  HL = summary array pointer
;   E = field number
;   B = summary number
;   C = number of control break fields
;
mk1ave:	push h
	push d
	push b
	dcx h
	mov a,m
	cpi hole
	lda fdline
	push psw	;save line number
	jnz mkave1
	dcr a		;no total requested, back up to non-printing line
mkave1:	dcr a
	sta fdline
	lhld fields
	mov a,m
	sta avfld1	;set total field number
	call mkatot	;make total field
	pop psw
	sta fdline	;restore line number
	call getctl	;get print control code
	sta avctl	;put into name
	call gtbase	;get base field parameters
	sta avname
	lxi h,aveblk
	mvi c,blkln8
	call addfd0	;add fdb
	pop b
	pop d
	pop h
	ret
;
; make 1 maximum field
;   E = field number
;   B = summary number
;   C = number of control break fields
;
mk1max:	push h
	lxi h,mxtype
	mvi a,f.max	;function number for maximum
	jmp mkmin0
;
; make 1 minimum field
;   E = field number
;   B = summary number
;   C = number of control break fields
;
mk1min:	push h
	lxi h,mntype
	mvi a,f.min	;function number for minimum
mkmin0:	sta mxfcn
	push d
	push b
	lxi d,fcname
	mvi b,fcnlen
	call copyhl
	pop b
	pop d
	push d
	push b	
	lhld fields
	mov a,m
	sta mxfld1	;set field number in calc
	call getclr	;get clear flag
	sta mxclr
	call getctl	;get print control code
	sta mxctl	;put into name
	call gtbase	;get base field parameters
	sta mxname	;name length
	mov a,c		;base field number
	sta mxfld2	;set second field number into calc
	lxi h,maxblk
	mvi c,blkln9
	call addfd0	;add fdb
	pop b
	pop d
	pop h
	ret
;
; get clear code as function of:
;  C = number of control break fields
;  B = summary number (starting with 1)
;
getclr:	mov a,b
	dcr a
	cmp c
	jc gtclr1	;jif not page, report
	sub c
	adi 10
gtclr1:	adi 0F3H
	ret
;
; get control code as function of:
;  C = number of control break fields
;  B = summary number (starting with 1)
;
getctl:	mov a,b
	dcr a
	cmp c
	jc gtctl1	;jif not page report
	lda pgflag	;'P'
	rz
	lda rpflag	;'R'
	ret
;
gtctl1:	adi '1'
	ret
;
; get name length into ACC, ptr into HL for summary number in ACC
;
getnam:	push d
	push b
	mov b,a
	lhld linem4	;summary name lengths
	xchg
	lhld snline	;summary name line
gtnam1:	ldax d
	dcr b
	jz gtnam2	;jif done	
	push d
	adi 4		;padded with 4 spaces
	mov e,a
	mvi d,0
	dad d		;point next name
	pop d
	inx d		;next name length
	jmp gtnam1
;
gtnam2:	pop b
	pop d
	ret
;
; add FDB
;  HL = block pointer
;  DE = name pointer
;   C = block length without name and starting 5 bytes
;   B = name length
;
addfdb:	mvi a,0FFH
	sta basdec	;say not decimally aligned
addfd0:	push d		;save name pointer (entry with basdec set)
	push h		;save block pointer
	inx h		;point edit byte
	mov a,m
	ani 0FFH-fe.edm
	mov m,a
	lda basdec	;base field decimal offset -> ACC
	inr a
	jz addfd1	;jif not decimally aligned
	mov a,m
	ori fe.edm	;say we need an edit mask
	mov m,a
	lda fdlen
addfd1:	mov e,a
	mov a,b		;name length
	add c		;add name length into total
	adi blkln0	;add count for fdb length, fdlen, fdcol, fdline
	lxi h,fdblk+1	;point high order FDB length
	mvi m,0
	add e		;add length for edit mask
	jnc addfd2
	inr m		;bump high order length
addfd2:	add e
	jnc addfd3
	inr m
addfd3:	dcx h		;point lo order length
	mov m,a
	mvi a,blkln0
	call putblk	;put into free space
	pop h
	mvi a,fdedw-fldblk
	call ptblk0	;put portion up to edit mask
	mov a,e
	ora a
	cnz addfd4	;put edit mask
	mov a,c
	sui fdedw-fldblk
	call putblk	;put rest into free space (except name)
	pop h
	mov a,b		;name length
	ora a
	cnz putblk	;put name into free space
	lhld fields
	inr m		;add into count
	ret
;
; put edit mask
;  E = field length
;
addfd4:	lda eddec1	;character in edit control word for decimal
	call addfd5
	lda eddec2	;character in edit constants word for decimal
addfd5:	push b
	mov b,a
	lda basdec	;offset to decimal
	mov c,a
	ora a
	cnz ptzero	;put floating minus and leading digit positions
	call putb	;put decimal character
	mov a,e
	sub c
	dcr a
	cnz ptzero
	pop b
	ret
;
; point to entry in array
;  HL = array start
; ACC = entry number
;
pentry:	lxi d,fieldl
pentr0:	ora a
	rz
pentr1:	dad d
	dcr a
	jnz pentr1
	ret
;
; find field in form
;  ACC = field number
;
fndfld:	lhld fields	;point to field descriptor block start
	cmp m
	jnc badfdb
fndblk:	inx h		;skip number of fields
	ora a
	rz
fdfld1:	push psw
	call nxtfdb
	pop psw
	dcr a
	jnz fdfld1	
	ret
;
; for fdb pointer in HL, get next fdb pointer into HL
;  set z-flag if at end
;
nxtfdb:	push b
	call getnxo	;get offset to next fdb in BC
	dad b
	pop b
	mov a,m
	inx h
	ora m
	dcx h
	ret
;
; get offset to next fdb into BC
;
getnxo:	mov c,m
	inx h
	mov b,m		;get second byte of length
	dcx h
	ret

	page
;
; make form image
;
mimage:	lxi h,0
	shld curcol	;clear current line and column
	lhld nxfree
	shld fimage	;save pointer
	call pheadp	;put page header
	call psummh	;put lines for summary headers
	call pfldnl	;put in field name line
	call pdetail	;put detail line
	call psummt	;put lines for summary trailer
	mvi a,arraye
	call ptchar	;put image end
	mvi a,3
	call ptzero	;put ldbs
	lda curline
	sta flines	;set number of lines
	ret
;
; put report header into form image
;
pheadp:	lxi h,rptx01
	call pstring	;put string, return column in C
	lxi h,fname	;point file name
	lda rptx02	;length of ' REPORT'
	mov b,a
	dcr b
phead1:	inr b		;add number of letters in report name
	mov a,m
	ora a
	inx h
	jnz phead1
	call clused	;number of columns used
	sub b
	rar		;center
	sui 1		;current column
	call pspace	;put number of spaces in ACC
	call ptctlb	;put ^B
	lxi h,fname
	call pstring	;put report name
	lxi h,rptx03
	call pstring	;' REPORT'
	call putcr
	call ptpage	;'P'
	lda mocol
	dcr a
	call pspace	;space to date
	mvi a,blkln2
	lxi h,datblk	;'__/__/__',ctlb,cr
	call putblk 
	call ptpage	;'P'
	call putcr
	lda pgflag	;'P'
	sta ctlchr
	ret
;
; put lines for summary headers
;
psummh:	lhld keydes
	mov a,m
	ora a
	rz		;no summaries
	mov b,a		;number of summaries
	mvi c,0		;first summary to check
	mvi a,3
	call fndfld	;point first summary header field
psumh1:	call p1sumh	;put 1 summary header
	call nxtfdb
	inr c
	dcr b
	jnz psumh1
	ret
;
; put 1 summary header
;  HL = FDB ptr
;   C = summary number (starting with zero)
;
p1sumh:	push h
	push b
	mov a,c
	call ckused	;see if summary used
	mvi b,'.'
	jz p1smh1	;jif not used
	mov a,c
	adi '1'		;summary print control character
	mov b,a
	sta ctlchr
p1smh1:	push b		;save print control byte
	call blankl	;put blankl line or remove line if not used
	call putb
	mvi a,' '
	call ptchar
	call ptctlb	;^B
	mov a,c
	inr a
	xchg		;save FDB pointer in DE
	call getnam	;get summary name pointer into HL, length into ACC
	mov b,a
	call putblk	;put summary name
	lxi h,rptx04	;' = '
	call pstring
	inx d
	inx d
	ldax d		;get field length
	call ptcfld	;put field
	call ptctlb
	call putcr
	pop b
	call blankl	;put blankl line or remove line if not used
	pop b
	pop h
	ret
;
; put blank line if b <> '.', else remove the line
;
blankl:	mov a,b
	cpi '.'
	jnz ptctln	;put control line
;
; remove a line from FDB's
;
remlin:	push h
rmlin0:	lhld fields	;entry with HL on the stack
	inx h		;point first field
rmlin1:	push h		;save pointer to field
	inx h
	inx h
	inx h
	inx h		;point line number
	lda curline
	cmp m
	jnc rmlin2
	dcr m		;this is all there is to removing a line at this point
rmlin2:	pop h
	call nxtfdb
	jnz rmlin1
	pop h
	ret	

;
; put in field name line
;  HL = first FDB
;
pfldnl:	push h
	xchg
	lhld array3	;name list
	call putctl	;put last print control character
	call ptctls	;^S
	mvi c,1		;current column
pfldn1:	push d
	inx d
	inx d
	inx d
	ldax d		;get field column
	sub c		;current column
	call pspace	;space to right column
	ldax d
	mov c,a
	call gnamln	;get name length into ACC
	push psw
	call putblk	;put name
	pop psw
	add c
	lxi b,fieldl
	dad b		;point next field name
	mov c,a		;current column
	pop d
	xchg
	call nxtfdb
	xchg
	mov a,m
	cpi arraye
	jnz pfldn1
	call ptctls
	call putcr
	pop h
	ret
;
; put detail line
;  HL = FDB pointer
;
pdetai:	lda slflds
	mov b,a
	mvi c,0		;starting column
pdeta1:	push h
	inx h
	inx h
	inx h
	mov a,m
	sub c
	call pspace	;space to field
	mov a,m		;current column
	dcx h		;point back to field length
	add m
	mov c,a
	mov a,m		;field length
	call putfld	;put field
	pop h
	call nxtfdb
	dcr b
	jnz pdeta1
	call putcr
	ret
;
; put summary trailer lines
;
psummt:	lhld keydes
	mov a,m
	mov b,a
	mov c,a
	ora a
	jz psumm2
psumm1:	call cbused
	cnz p1tlr	;put one trialer
	dcr b
	jnz psumm1
	mov b,c
psumm2:	inr b
	inr b
	call cbused
	cnz prptt	;put report trailer
	dcr b
	call cbused
	cnz ppaget	;put page trailer
	ret
;
; put one summary trailer
;  C = number of control break fields
;  B = summary number to put
;
ppaget:	call p1tlr	;make trailer lines
	call ptctln	;put control break line
	call ptctln	;put control break line
	call ptctln	;put control break line
	call ptctln	;put control break line
	ret
;
prptt:
p1tlr:	push b
	call getctl	;get control character into ACC
	sta ctlchr	;save
	call ptchar
	call putcr
	call putctl	;put print control char
	lxi h,rptx05
	call pstring	;' Summary for '
	mov a,b
	call getnam	;get summary name and length
	call putblk
	mov a,b
	dcr a
	cmp c
	cz ppagef	;put page field
	call lnxfld	;clear CY if conut field present
	cnc pcntf	;put count field if found
	mvi a,':'
	call ptchar
	call putcr
	lxi h,datblk	;no message
	mvi c,'.'	;use for print control character
	call ptlrln	;put total/count line for averages w/o them
	mvi b,4		;number of summary lines to do
	lxi h,rptx08	;'  Total'
p1tlr1:	push h
	lda ctlchr
	mov c,a		;print control character
	call ptlrln	;print trailer line
	pop h
	inx h		;point next line message
	inx h
	dcr b
	jnz p1tlr1
	pop b
ptctln:	call putctl
	call putcr
	ret
;
; put trailer line
;
ptlrln:	push h		;save text pointer ('  Total ')
	call lnxfld	;locate next field on this line
	jc rmlin0	;jif not on this line to remove a line from the FDB's
	xthl		;save FDB pointer, get text pointer
	mov a,c
	call ptchar	;put print control
	call pstring	;put text
	pop h		;FDB pointer
ptlrl1:	push h		;save FDB pointer
	inx h
	inx h
	inx h		;point field column
	lda curcol	;current column
	mov c,a
	mov a,m
	sub c
	cnz pspace	;space to the right column
	dcx h		;point field length
	mov a,m		;get length
	call putfld	;put field
	pop h
	call nxtfdb
	jz putcr	;done if last fdb
	call lnfld1	;get next field, assumes HL & DE still set
	jnc ptlrl1
	call putcr
	ret
;
; locate the next field on this line
;
lnxfld:	lhld curcol	;current col
	xchg
	lhld fields
	inx h		;point first field
lnfld1:	push h
	inx h
	inx h
	inx h
	inx h		;point line
	mov a,m
	cmp d
	jnz lnfld2	;not on this line
	dcx h
	mov a,m
	sub e		;ACC = number of columns to get there 
	jnc lnfld3	;success
lnfld2:	pop h
	call nxtfdb
	jnz lnfld1
	stc
	ret		;not found
;
lnfld3:	pop h
	ret
;
; set current column into next field on the line
;
setcol:	call lnxfld
	rc		;there is none
	inx h
	inx h
	inx h		;point column
	mov m,e
	ret	

;
; put count field
;
pcntf:	lxi h,rptx06	;' (Count = '
	call pstring
	call setcol	;set current column into field
	mvi a,cntlen	;count field length
	call putfld
	lxi h,rptx07
	call pstring	;')'
	ret
;
; put page field
;
ppagef:	mvi a,' '
	call ptchar
	call setcol	;set column into first field on this line
	mvi a,paglen
	call putfld	;put field
	ret

	page
;
; put a string
;
pstrin:	call indptr	;convert indirect pointer to absolute
pstrn1:	mov a,m
	ora a
	rz
	call ptchar
	inx h
	jmp pstrn1
;
; put number of spaces in ACC
;
pspace:	call pbytes
	db ' '
	ret
;
; put field, ACC = length
;
ptzero:
putfld:	call pbytes
	db 0
	ret
;
; put control break field
;
ptcfld:	call pbytes
	db cbchar
	ret
;
; put byte following call for count in ACC
;
pbytes:	xthl
	push b
	mov b,a
	mov c,m		;what to put
	inx h
pbyte1:	mov a,c
	call ptchar
	dcr b
	jnz pbyte1
	pop b
	xthl
	ret
;
; put number of characters in ACC from HL
;
putblk:	push h
	call ptblk0
	pop h
	ret
;
ptblk0:	push b
	mov b,a
ptblk1:	mov a,m
	call ptchar
	inx h
	dcr b
	jnz ptblk1
	pop b
	ret
;
; put ^B
;
ptctlb:	mvi a,ctlb
	jmp ptchar
;
; put cr
;
putcr:	mvi a,cr
	jmp ptchar
;
; put 'P'
;
ptpage:	lda pgflag
	jmp ptchar
;
; put print control character 
;
putctl:	lda ctlchr
	jmp ptchar
;
; put ^S
;
ptctls:	mvi a,ctls
	jmp ptchar
;
; put character in B
;
putb:	mov a,b
ptchar:	push h
	push d
	push b
	lhld nxfree
	mov m,a
	inx h
	shld nxfree
	lxi h,curcol
	inr m		;assume printing
	cpi cr
	jnz ptchr1	;jif not cr
	mvi m,0		;reset column
	inx h
	inr m		;bump line number
ptchr1:	lhld ctfree	;number of bytes left
	dcx h
	shld ctfree
	mov a,h
	ora l
	jz memerr	;out of room
	pop b
	pop d
	pop h
	ret	

;
; write new form file
;
wtform:	call resdsk	;restore current disk
	call rptype	;set type to "RPT"
	call makfile	;make directory entry and init bufptr
	lxi h,filen
	lxi b,8+nparms
	call wtdata	;write file name
	lhld cbldes
	mov a,m
	add a
	inr a
	mov c,a
	call wtdata	;write control break levels
	lhld forms
	xchg
	lhld fields
	call wtfrm2	;write files
	lhld fimage
	xchg
	lhld nxfree
	call wtfrm2	;write form image
	lhld fields
	xchg
	lhld fimage
	call wtfrm2	;write fields
;
; close file
;
clsfil:	lhld bufptr
clsfl1:	mvi m,ctrlz
	inr l
	jnz clsfl1
	call wtbuff
	lxi d,rptfcb
	mvi c,closef
	call imdos	;close it
	ret
;
; write from DE to HL
;
wtfrm2:	call subde
	xchg
	mov b,d
	mov c,e
	call wtdata	;write forms
	ret
;
; write data into buffer
;
wtdata:	xchg
	lhld bufptr
wtdat1:	ldax d
	mov m,a		;store in buffer
	inx d
	inr l
	cz wtbuff	;write buffer if full
	dcx b
	mov a,b
	ora c
	jnz wtdat1
	shld bufptr
	xchg
	ret
;
; write buffer to disk
;
wtbuff:	push d
	push b
	lxi d,rptfcb
	mvi c,writef
	call imdos
	pop b
	pop d
	lxi h,defbuf
	rz		;done if zero
	lxi d,abtms5	;disk full
	jmp abort


;
negde:	mov a,e
	cma
	mov e,a
	mov a,d
	cma
	mov d,a
	inx d
	ret
;
; block for file descriptor
;
filebk:	db 1		;one file
	ds 2		;length
noname:	db 0		;ddtype
	db dm.aim	;ddmisc

blkln1	equ $-filebk

datblk:	db 0,0,'/'
	db 0,0,'/'
	db 0,0,ctlb,cr

blkln2	equ $-datblk
;
; FDB blocks
;

;
; block for date fields
;
datebk:	db numexf	;number of fields

	dw 36H		;FDB length for month
	db 2
mocol:	ds 1		;column for month (unknown)
	db 3		;line
	db ft.inp
	db fe.rj
	db ' '		;pad character
	dw 0,0
	dw 0,0
	db 14H,'Enter report month: '
	db 0,0FEH,0,0F2H
	db 0CH,'REPORT MONTH'

	dw 32H		;FDB length for day
	db 2
daycol:	ds 1		;column for day (unknown)
	db 3		;line
	db ft.inp
	db fe.rj
	db ' '		;pad character
	dw 0,0
	dw 0,0
	db 12H,'Enter report day: '
	db 0,0FEH,0,0F2H
	db 0AH,'REPORT DAY'

	dw 34H		;FDB length for year
	db 2
yrcol:	ds 1		;column for year (unknown)
	db 3		;line
	db ft.inp
	db fe.rj
	db ' '		;pad character
	dw 0,0
	dw 0,0
	db 13H,'Enter report year: '
	db 0,0FEH,0,0F2H
	db 0BH,'REPORT YEAR'

blkln3	equ $-datebk

;
; start block for all fields
;
fdblk:	ds 1		;FDB length (dependent on name length)
	db 0		;high order
fdlen:	ds 1		;length
fdcol:	ds 1		;column
fdline:	ds 1		;line

blkln0	equ $-fdblk

;
; block for file derived fields
;
fldblk:	dw 0
	db ' '		;pad character
	db 1		;file number
fdifld:	ds 1		;field number in input file
	dw 0,0
fdcbl:	dw 0
fdedw:	dw 0
	db 0F0H,0
	db 0F2H
fdname:	ds 1		;name length

blkln4	equ $-fldblk

;
; block for page number
;
pagblk:	db ft.clc	;calculated
	db fe.pgd
	db 0		;pad character
	db 0		;file number
	db 0		;field number in input file
	dw 0,0
	dw 0
	db 2
	db c.fcn,f.pag
	db 0,0FDH,0,0F2H
pgname:	ds 1		;name length
	db 'N '

blkln5	equ $-pagblk

;
; block for count
;
cntblk:	db ft.clc	;calculated
	db fe.pgd+fe.cbd
	db 0		;pad character
	db 0		;file number
	db 0		;field number in input file
	dw 0,0
	dw 0
	db 4		;function length
ctfld:	ds 1		;field number
	db c.add,c.num
	db '1'
	db 0
	db 0F0H,0
ctclr:	ds 1		;clear flag
ctname:	ds 1		;name length
	db 'C '

blkln6	equ $-cntblk

;
; block for total
;
totblk:	db ft.clc	;calculated
	db fe.pgd+fe.cbd+fe.rj
	db ' '		;pad character
	db 0		;file number
	db 0		;field number in input file
	dw 0,0
	dw 0
	db 3		;function length
ttfld1:	ds 1		;field number
	db c.add
ttfld2:	ds 1		;second field numbner
	db 0
	db 0F0H,0
ttclr:	ds 1		;clear on
ttname:	ds 1		;name length
	db 'TOT'
ttctl:	ds 1		;print control (part of field name)
	db ' '

blkln7	equ $-totblk

;
; block for average
;
aveblk:	db ft.clc	;calculated
	db fe.pgd+fe.cbd+fe.rj
	db ' '		;pad character
	db 0		;file number
	db 0		;field number in input file
	dw 0,0
	dw 0
	db 3		;function length
avfld1:	ds 1		;field number
	db c.div
avfld2:	ds 1		;second field numbner
	db 0,0F0H,0,0F2H
avname:	ds 1		;name length
	db 'AVE'
avctl:	ds 1		;print control (part of field name)
	db ' '

blkln8	equ $-aveblk

;
; block for max/min
;
maxblk:	db ft.clc	;calculated
	db fe.pgd+fe.cbd+fe.rj
	db ' '		;pad character
	db 0		;file number
	db 0		;field number in input file
	dw 0,0
	dw 0
	db 7		;function length
	db c.fcn
mxfcn:	ds 1		;function number
	db c.lp
mxfld1:	ds 1		;first field number
	db c.cma
mxfld2:	ds 1		;second field numbner
	db c.rp
	db 0
	db 0F0H,0
mxclr:	ds 1		;clear flag
mxname:	ds 1		;name length
fcname:	ds fcnlen
mxctl:	ds 1		;print control (part of field name)
	db ' '

blkln9	equ $-maxblk

spaces:
nofld:	db '    '	;no field name
	db '    '
	db '    '
	db '    '
	db '    '
	db '    '
	db '    '
	db '    '
	IF ATEBIT
	db ' '
	ENDIF
callsp:	ds 2		;save caller's stack pointer for abort return
stkptr:	ds 2		;stack pointer
freest:	ds 2		;free space start
nxfree:	ds 2		;next free space
ctfree:	ds 2		;number of bytes left in free space
curdsk:	ds 1		;save current
entdsk:	ds 1		;entry disk
bufptr:	ds 2		;read file buffer ptr
flnptr:	ds 2		;field length table pointer
decptr:	ds 2		;decimale offset table pointer 
basdec:	ds 2		;base field decimal offset
svline:	ds 1		;save line number here
fldcnt:	ds 1		;temporary for fdused
lineln:	ds 2		;line length in summary array
fstfld:	ds 1		;first file field
curcol:	ds 1		;current column
curlin: ds 1		;must follow curcol
ctlchr:	ds 1		;print control character
;
; the following up to cbldes must be in this order
; 
filedk:	db 0		;dddisk = drive for file
filen:	ds 8		;ddname = report name
flines:	ds 1		;number of report lines
cbreak:	db 0		;number of control break fields
	dw 0,0		;report parameters
	dw 0,0
	dw 0,0
	dw 0

cbldes:	ds 2		;control break descriptor block
forms:	ds 2		;number of forms
fimage:	ds 2		;pointer to form image
fields:	ds 2		;pointer to field descriptor blocks

rptfcb:	ds 1		;disk drive
rpname:	ds 32		;rest of FCB ** must follow rptfcb

	end