/	XLIST	/WPSELC.PA
/WPSELC.PA
/
/	COPYRIGHT (C) 1980
/	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS 01754
/
/	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
/	ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
/	INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
/	COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
/	OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
/	TRANSFERRED.
/
/	THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
/	AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/	CORPORATION.
/
/	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
/
/++
/	FACILITY:
/
/	ABSTRACT:
/
/	ENVIRONMENT:
/
/	AUTHOR:			CREATION DATE:
/
/	MODIFIED BY:
/
/
/	,  : VERSION
/
/	044	RCME	12-APR-85	Fix parsing of tech & multinational
/					characters in field names
/
/	------------------- All below refer to V2.0 and earlier ---------------
/
/	043	HLP	13-SEP-83	Delete PRLOCK since DECmate is single user
/	042	WCE	06-MAY-83	Fixed L.P. to work with numbers to 4095
/	041	HLP	02-MAY-83	Delete JSTRTs on PRJOB,extra DCA PRSTTS
/	040	GDH	 1-Feb-83	Fixed <field>=<*> selection.
/	039	GDH	16-DEC-82	Fixed match logic when dealing w/ big recrds.
/	038	DRH	2-15-81		FIXED TYPO IN CODE NOTICED BY G.HOSLER
/					ALSO ADDED PSUEDO-CODE TO "CNTROL" RTN
/	037	DAO	26-OCT-81	ADDED WTSELC.PA TO TOP OF THIS FILE
/					SINCE NO MORE ROOM IN MASTER.INF
/					(ONLY NINE FILES ALLOWED PER LINE)
/	036	EH	22-OCT-81	report error if illegal number in LP
/	035	AIB	22-Oct-81	changes to accomodate editor math
/					error reporting, at REPORT et seq
/	033	DRH	21-OCT-81	STRIP OUT SOFT RETURN (WITH HYPHEN)
/	032	GDH	20-OCT-81	Deimplemented LOCK/UNLOCK.
/	031	DRH	14-SEP-81	SET MATH INIT CALL FROM WPSELC TO ALSO
/					SET FLAG SAYING IN LP MATH
/	030	DAO	19-AUG-81	Added changes for selectin on
/					numeric fields
/	029	DAO	23-JUL-81	FIXED LP TO PRINTER BUG IN PRNQUE
/	028	DRH	31-JUL-81	SET UP "ERRHAN" TO BYPASS "DOMATH"
/	027	DRH	31-JUL-81	MADE CHECK MATH ACTIVE SUBRTN GENERAL
/	026	JRF	28-JUL-81	Add CIF,CDF equates for menu field
/	025A	DRH	24-JUL-81	HANDLE MATH LINE BUFFER OVERFLOW ERROR
/	025	JRF	23-JUL-81	Make modifications for error reporting
/					thru MN1
/	024	JRF	22-JUL-81	Corrected count of max. numeric chars.
/					 allowed in a field value in LDFLD
/	023	DRH	22-JUL-81	FIX TO DUMP CTRL BLOCK IF NOT MATH
/	022	DRH	22-JUL-81	SCREEN OUT WRAPS & SOFT SPACES BEFORE
/					CHAR SENT TO MATH LINEBUFFER (LNEBUF)
/	021	DRH	21-JUL-81	HANDLE END OF CTRL BLOCK SPECIAL CASES
/	020	DRH	21-JUL-81	UNBUNDLED LIST PROCESSING MATH
/	019	JRF	09-JUL-81	Added calls to IOA
/	018	DAO	9-JUL-81	Added changes for LP math
/	017	DAO	08-JUL-81	Changes to move LP to field 5
/	0016	TT	07-JUL-81	Removed superfluous conditionals
/	0015	JM	01-APR-81	Changes for CANADA
/	0014	JM	10-MAR-81	Added CANADIAN text
/	0013	JM	09-MAR-81	Added DUTCH text
/	0012	JM	06-MAR-81	Added FRENCH text
/	0011	LDB	20-NOV-80	Add error for full diskette
/	0010	GR,DAO	17-OCT-80	CONDITIONALIZED ESCAPE SEQUENCES
/	0009	DIM	23-SEPT-80	Merge with x3.5
/	0007	DIM,JM	15-SEPT-80	Merged Scandi and Europe/English
/	0006	REG	12-AUG-80	INSERTED THIS STANDARD HEADER
/	0005	DSS	09-JUL-80	MODIFIED FOR ENGLISH/FRENCH-CANADIAN
/	0004 	CMW	05-MAY-80	ENTERED CANADA TRANSLATIONS
/	0003	DSS	17-APR-80	ENTERED DUTCH FIXES
/	0002	GLT 10-Apr-80	Add LCMAP value to control the mapping constant
/	/		that gets added to an ASCII value to change it from
/	/		UPPER to lower case. This allows the programmer
/	/		to disable the case changing at will. Presently
/	/		German disables the case value.
/	0001	GLT	08-Feb-80	Add French German and Dutch translations
/	/		and did amazing things with angle brackets and accented
/	/		characters. By adding the value MAPCON. MAPCON
/	/		defines the first "x" characters that will be mapped
/	/		into lowercase starting with SIXBIT "A". For English
/	/		MAPCON=33 (base 8, 26 base 10) to capitalize A-Z.
/	/		In FORIN systems MAPCON=36 (base 8, 29 base 10) to
/	/		capitalize A-Z plus the three special foreign
/	/		characters. (See OUTSTR for current values).
/	/		French diacritical substitutions:
/	/		"["-L.A.E, "]"-L.G.E
/	/		German diacritical substitutions:
/	/		"["-L.U.A, "\"-L.U.O, "]"-L.U.U
/	2.4D+	RLT	10/17/77	UNDERLINED SPACE (ETC) BUG IN GETCHAR
/	2.Q-1	RLT	09/24/77	NOP'D PRNQUE ROUTINE FOR WT78
/	2.P-4	KEE		ADD CODE TO UNLOCK FILES FOR 102 SYSTEMS
/
/--
/
/WTSELC APPENDED TO TOP OF WPSELC TO CUT DOWN ON NUMBER OF FILES	/A037
/ASSEMBLED FROM 10 TO 9 WHICH IS PALS LIMIT				/A037
/WTSELC - WRITES OUT LIST PROCESSING SELECT PROGRAM

/MODIFICATIONS
/003	RCME	07-Aug-85	/allow MNC's in numeric fields
/
/******************* all below refer to v2.0 or earlier ************************
/
/OO2	DAO	21-AUG-81	/DELETED WRITE OUT CODE FOR
				/SECOND OVERLAY NOT USED ANYMORE
/001	DAO	26-JUN-81	/CHANGES TO MOVE LP TO FIELD 5

	FIELD 0
	*200
	JMP I	.+3
	JMP I	.+1
	7600
	RXLOAD
	*RXLDLS
	RXEWT=4
	RXEWT
	0
	RXQBLK=11
	RXQBLK
	.

	DLOSEL; 200;CDF 20;-DSOSEL	/WRITE OUT WPSELC	/M001
	DLOSOV;2200;CDF 30;-DSOSOV	/WRITE OUT AN OVERLAY	/MOO1
	0


CDFMYF=CDFLP								/M017
CDFBUF=CDF BUFFLD							/M017
MNUFLD=20								/A026
CDFMNU=CDF MNUFLD							/A026
CIFMNU=CIF MNUFLD							/A026
CDIMNU=CIF CDF MNUFLD							/A026
CDFMNU=CDF 20								/A020

	FIELD	2
	*200								/M017

/ SELCT AND SELCTX ARE BOTH INITIALLY SET BY START ROUTINE.  THIS WAS	/A019
/  DONE SO THAT A MATH ERROR ENCOUNTED WITHIN A MATH CONTROL BLOCK	/A019
/   PREVIOUS TO THE READING OF THE FIRST RECORD COULD BE REPORTED.	/A019
/    SELCT *** MUST *** RESIDE AT ADDRESS ZERO OF A PAGE.		/A019
/     IF MATH DETECTS AN ERROR, IT WILL MAKE A RETURN TO SELCTX.	/A042
/      THIS ROUTINE IS CROSS FIELD CALLABLE BECAUSE OF AN EDITOR CALL	/A042

SELCT,	0	/MAIN ROUTINE TO MATCH AND SELECT RECORDS
		/CALLED BY:
		/CIFLP							/M017
		/JMS I	(SELCT)
		/RETURN (AC =0 IF RECORD FOUND, AC = -1 IF NO MORE RECORDS)

	CLA
	RDF			/GET FIELD FROM WHENCE I CAME
	TAD	CIDF0		/MAKE CIF, CDF
	CDFMYF			/SET DATA FIELD RIGHT
	DCA	SELCTX		/STORE INSTRUCTION
	TAD	RECNUM		/SEE IF FIRST TIME CALLED ?
	SNA CLA
	JMP	SLTSFD		/YES, DON'T BOTHER TO GET INITIAL '<'
RECLP,	JMS	DISREC		/SHOW REC NO. BEING PROCESSED
SLBLP,	JMS	GETCHR		/GET 1ST 'REAL' CHAR OF RECORD
	JMP	SELDNX		/EOF, GO FINISH UP
	AND	P177		/LOSE CONTROL
	TAD	(-41		/NON-PRINTING CHAR ?
	SPA
	JMP	SLBLP		/YES, KEEP LOOKING FOR '<'
	TAD	(-33		/NO, SEE IF A '<'
	SZA CLA
	JMP	REVCRBR		/ ERROR - TEXT BETWEEN RECORDS		/M025
SLTSFD,	JMS	SINFLG		/YES, INITIALIZE MATCH FOUND FLAGS
	JMS	LRCBUF		/LOAD A RECORD INTO EDIT BUFFER FIELD
	JMS	CHKREC		/CHECK FROM - TO RECORD NUMBER		/M042
	JMP	SLBLP		/SKIP RECORD, AND LOOK FOR NEXT RECORD	/M042
	JMP	SELDNX		/DONE ALL RECORDS OR HALT FLAG DETECTED	/M042

	JMS	INCNUM		/COUNT RECORD BEING PROCESSED		/A042
	RECPRO			/POINTER TO RECORD BEING PROCESSED	/A042
	TAD	(RECBUF		/RESET PTR IN AUTO-INDEX
	DCA	RCBPTR		/AFTER FIRST '<'
FNLP,	JMS	LFLDNM		/LOAD INTO GPBUF
	JMP	CHKMAT		/EOR, GO CHECK RECORD MATCH
	TAD	(SYMTAB-1	/GET SYMBOL TABLE ADR - 1
	DCA	SYTPTR		/PUT IN AUTO-INDEX
SYTBLK,	TAD I	SYTPTR		/GET AN ENTRY
	SZA			/ANY LEFT ?
	JMP	SYTBL1		/YES
	JMS	GFDEND		/NO, GET TO END OF FIELD
	JMP	FNLP		/GET NEXT FIELD
SYTBL1,	DCA	SYTSRC		/STORE FOR COMPARE
	TAD	FNCNT		/GET SIZE OF FN TO SEARCH
	JMS	XSCMP		/SEE IF MATCHES
	GPBUF
SYTSRC,	0
	CDFMYF			/FIELD OF SYMTAB FOR COMPARE
	SZA CLA
	JMP	FNLP1		/YES, FOUND AN ENTRY
	ISZ	SYTPTR		/NOPE, BUMP PTR
	JMP	SYTBLK		/TRY NEXT ENTRY

CKTRU,	DCA	SFFLG		/SET FOR SUCCESSFUL MATCH		/MJOE
SSMAT,	TAD	SFFLG		/SEE IF RECORD MATCHED
	SZA CLA
	JMP	RECLP		/NO, KEEP TRUCKING
	JMS	INCNUM		/COUNT THIS RECORD AS A SELECTED RECORD	/A042
	SUCREC			/POINTER TO MERGED RECORD COUNT		/M042
	SKP			/SKIP EOF FLAG
SELDNX,	AC7777
	JMS	DOMATH		/DO MATH ON THIS RECORD			/A018
SELCTX,	0			/FOR CIF CDF (DON'T FORGET - INITIALLY	/A019
				/SET BY START ROUTINE. SEE NOTE ABOVE	/A019
	JMP I	SELCT		/RETURN

CHKMAT,	AC7777			/SET FLAG FOR NO MATCH
	DCA	SFFLG
	TAD	(SPECTB		/GET 1ST LOC OF SPEC TABLE
	DCA	SPCSCN		/AND SAVE IT
	TAD I	(SPECTB		/GET FIRST TYPE WORD
	SNA
	JMP	CKTRU		/0 TYPE, PROCESS ALL RECORDS
	SPA CLA			/SEE IF 'TRUE' (POS.)
	JMP	CKNG2		/NO, LOOK FOR A 'TRUE' ENTRY
	JMP	CHKML		/YES, GO GET NEXT TYPE

CHKML1,	DCA	SFFLG		/SET FOR MATCH
CHKML,	JMS	GTYPE		/GET A TYPE WORD
	SNA
	JMP	CKTRU		/0 TYPE, RECORD MATCHED, ALL DONE
	SPA			/SEE IF 'TRUE'
	JMP	CKNEG		/PROBABLY NOT, GO MAKE SURE
	AND	P177		/GET RID OF FLAGS
	TAD	(-1		/SEE IF 'OR IF' FOUND
	SNA CLA
	JMP	CHKML1		/YES, SUCCESS
	JMP	CHKML		/NO, BUT THAT'S O.K.

CKNEG,	AND	P177		/GET RID OF FLAGS
	TAD	(-1		/SEE IF FALSE 'OR IF' (-1)
	SNA CLA
	DCA	SFFLG		/YES, SET FOR RECORD MATCHED AND CONTINUE
CKNG2,	JMS	GTYPE		/LOOK FOR A 1 (OR IF)
	SNA
	JMP	SSMAT		/NOTHING LEFT, GO CHECK MATCH
	SPA
	JMP	CKNG2		/'FALSE' DOESN'T HELP
	AND	P177		/GET RID OF FLAGS
	TAD	(-1
	SNA CLA
	JMP	CHKML		/FOUND IT, START LOOKING AGAIN
	JMP	CKNG2		/NOPE, KEEP LOOKING

RECNUM, 0			/ RECORD NUMBER				/M025
RECPRO,	0			/ RECORDS PROCESSED			/A025
SUCREC,	0			/ SUCCESSFULLY MERGED RECORDS		/M025
SFFLG,	-1
FNCNT,	0

NXTMCT,	XX			/ Routine to test for MCS char in field	/a003
	SZA			/ Is this a Start of Dead?		/a003
	JMP I	NXTMCT		/ No, skip the squish call		/a003
	CIFMTH			/ Yes, call the blaster in the maths code/a003
	JMS	MBHOOK		/ This is its address, as given in WPF1	/a003
		SQUISH		/ This is the blast number of the 7 to	/a003
				/ 8 bit squish routine.			/a003
	ISZ	NXTMCT		/ Make skip return with result of dead	/a003
	JMP I	NXTMCT

/--------------
	PAGE

FNLP1,	AC0001			/SAVE A PTR
	TAD	RCBPTR		/TO 1ST CHAR IN FIELD
	DCA	FDSTRT
	DCA	LDNMFL		/CLEAR NUMBER LOADED FLAG
	JMS	GFDEND		/GET TO END OF FIELD
	AC7777			/PICK UP SPEC ADDR
	TAD I	SYTPTR
FNLP2,	DCA	SPCPTR		/SAVE IN AUTO-INDEX
	TAD	SPCPTR		/GET PTR TO TYPE WORD
	DCA	PTYWD		/AND SAVE IT
	TAD I	SPCPTR		/GET FN LINK WORD
	DCA	NXTSPR		/AND SAVE
	TAD I	SPCPTR		/GET OR-COUNT
	IAC			/PLUS 1
	CIA
	DCA	ORCNT		/AND MAKE INTO A COUNTER
ORLP,	CLA			/MAKE EVERYTHING CLEAR
	ISZ	ORCNT		/SEE IF ANY OR-GROUPS LEFT
	JMP	.+2
	JMP	NXTSPC		/NO, GET NEXT SPEC
	TAD	FDSTRT		/YES, SET UP SEARCH
	DCA	RECSTR		/THE RECORD PTR
	TAD I	SPCPTR		/AND THE SPEC PTR
	DCA	SPCSTR
	TAD I	SPCPTR		/GET S-LENGTH
	DCA	SLEN		/AND SAVE IT
	TAD I	SPCPTR		/GET M-LENGTH
	DCA	MLEN
	TAD I	SPCPTR		/GET E-LENGTH
	DCA	ELEN
	TAD	SLEN		/SEE IF S-LENGTH IS POSITIVE
	SMA SZA CLA
	JMP	SSPRC		/YES, MEANS SPECIAL PROCESSING REQUIRED
	TAD	SLEN		/Test for existance test.		/A040
	TAD	MLEN		/ ...					/A040
	TAD	ELEN		/  ....					/A040
	SNA CLA			/ skip if some other test.		/A040
	JMP	SSRCH		/ test was for existance. so succeed!	/A040
	AC7777			/NO, SEE IF
	TAD	FDSTRT		/THE LENGTH OF THE FIELD
	CIA
	TAD	FDEND		/IS LONGER THAN
	CLL			/ Reset overflow indicator. Record length/A039
				/  can be up to 2500 (4704) characters.	/A039
	TAD	SLEN		/ S +
	TAD	MLEN		/ M +
	TAD	ELEN		/ E ?
	SNL			/ skip if no overflow. ie didn't have	/A039
				/  to borrow.				/A039
	JMP	ORLP		/NO, FAIL IMMEDIATELY

SSRCH,	IAC			/YES, ADD ONE
	CIA			/AND MAKE INTO A COUNTER
	DCA	RCRLFT		/OF CHARS LEFT FOR M SEARCH
	TAD	SLEN		/GET LENGTH TO SEARCH
	SNA			/ANYTHING?
	JMP	ESRCH		/NO, CHECK E
	JMS	SRCH		/YES, DO COMPARE
	SNA CLA
	JMP	ORLP		/FALSE, TRY NEXT OR-GROUP

ESRCH,	TAD	SLEN		/POINT TO RIGHT PLACE IN SPEC STR
	TAD	MLEN
	CIA
	TAD	SPCSTR
	DCA	SPCSTR		/AND MAKE NEW SPEC STR PTR
	TAD	ELEN		/GET E-LENGTH
	SNA			/ANYTHING?
	JMP	MSRCH		/NO, CHECK M
	TAD	FDEND		/YES, GET TO END OF FIELD - ELEN
	IAC
	DCA	RECSTR		/AND MAKE NEW RECORD STR PTR
	TAD	ELEN		/GET BACK E-LENGTH
	JMS	SRCH		/DO COMPARE
	SNA CLA	
	JMP	ORLP		/FALSE, TRY NEXT OR-GROUP

MSRCH,	TAD	MLEN		/TRUE, GET M-LENGTH
	SNA			/ANYTHING?
	JMP	TRUE		/NO, SO MUST BE TRUE
	TAD	SPCSTR		/YES, MAKE NEW SPEC PTR
	DCA	SPCSTR		/BY SUBTRACTING M-LENGTH
	TAD	SLEN		/ADD S-LENGTH TO
	CIA
	TAD	FDSTRT		/ADDR OF START OF STRING
	DCA	RECSTR		/AND MAKE INTO NEW REC STR PTR
MSRLP,	TAD	MLEN		/GET M-LENGTH FOR SEARCH
	JMS	SRCH		/DO COMPARE
	SZA CLA
	JMP	TRUE		/MATCHED, SET RECORD MATCH
	ISZ	RCRLFT		/FALSE, SEE IF ROOM LEFT TO SHIFT
	SKP
	JMP	ORLP		/NO, TRY NEXT OR-GROUP
	ISZ	RECSTR		/YES, BUMP REC STR PTR
	JMP	MSRLP		/AND TRY TO MATCH AGAIN

SSPRC,	AC0002
	TAD	MLEN		/NUMERIC COMPARE NEEDED ?
	SZA CLA
	JMP	NUM		/YES, GO FIGURE OUT WHICH TYPE
	AC7777			/NO, COMPUTE RECORD FIELD LENGTH
	TAD	FDSTRT
	CIA
	TAD	FDEND
	TAD	ELEN		/MINUS E-LENGTH, HAS 0 FOR NULL SEARCH AND LENGTH FOR EXACT SEARCH
	SZA CLA			/EQUAL TO 0 ?
	JMP	ORLP		/NO, FAIL IMMEDIATELY
	TAD	ELEN		/OTHERWISE, GET BACK E-LENGTH
	SNA			/NULL SEARCH ?
	JMP	TRUE		/YES, SET RECORD MATCH
	JMS	SRCH		/NO, DO EXACT SEARCH
	SNA CLA
	JMP	ORLP		/FALSE, TRY NEXT OR-GROUP
	JMP	TRUE		/TRUE, SET FLAG

NXTSPR,	0
ORCNT,	0
FDSTRT,	0
FDEND,	0
SLEN,	0
MLEN,	0
ELEN,	0
RCRLFT,	0
/--------------
	PAGE

SSRBRD,	0			/READS A CHARACTER FROM THE EDIT BUFFER
				/FIELD INTO THE AC USING RCBPTR AS AN
				/AUTO-INDEX REGISTER
	CLA
	CDFBUF			/CHANGE FIELDS
	TAD I	RCBPTR		/GET CHAR
	CDFMYF			/BACK TO HOME FIELD
	AND	P177		/NO CONTROLS
	TAD	(-10)		/Test for Start of Dead marker		/a044
	SNA			/Is it SOD?				/a044
	ISZ	DEADKEY		/Yes, set dead key flag			/a044
	TAD	(10-15)		/No, test for End of Dead		/a044
	SNA			/Is this End of Dead?			/a044
	DCA	DEADKEY		/Yes, reset dead key flag		/a044
	TAD	(15)		/Restore character value		/a044
	JMP I	SSRBRD		/RETURN

DEADKEY,ZBLOCK	1		/Dead key sequence flag			/a044

LRCBUF,	XX		/ THIS ROUTINE LOADS A RECORD INTO THE EDIT	/M025
			/  BUFFER FIELD FROM AFTER THE FIRST '<' USING	/M025
			/   THE GETCHR ROUTINE.				/M025
			/CALLED BY: (AC MUST = 0)			/M025
			/JMS	LRCBUF
			/REGULAR RETURN IF NO ERRORS ELSE ERROR EXIT	/M025

	DCA	SSLBFD		/SET LEFT BRACKET FLAG			/M025
LRBLP5,	TAD	(RECBUF-1)	/SET-UP PTR IN AUTO-INDEX
	DCA	RCBPTR
	TAD	(RECSIZ-1)	/SET-UP COUNTER
	DCA	SSCNT
	TAD	("<-200		/STORE THE INITIAL '<'
	DCA	T1		/ IN T1					/A025
	JMS	SSRBST
LRBLP,	JMS	GETCHR		/READ A CHAR
	JMP	REVPEOF		/ ERROR - END OF FILE			/M025
	DCA	T1		/SAVE CHAR
	TAD	T1
	AND	P177		/STRIP OFF CONTROLS
	TAD	(-74		/SEE IF A '<'
	SZA
	JMP	LRBLP1		/NOPE
	DCA	SSLBFD		/YES, SET FLAG
	JMP	LRBLP3		/AND STORE CHAR AWAY
LRBLP1,	TAD	(-2		/IS IT A '>'
	SZA CLA
	JMP	LRBLP2		/NO, CLEAR FLAG
	TAD	SSLBFD		/YES, IS FLAG SET?			/M025
	SNA CLA			/ SKIP IF: FLAG NOT SET FOR LEFT ANGLE	/M025
				/          BRACKET LAST CHAR. READ	/A025
	ISZ	SSLBFD		/YES, SET FOR END OF RECORD
LRBLP3,	JMS	SSRBST		/ STORE CHARACTER IN T1			/M025
	TAD	SSLBFD		/SEE IF A '<>' HAS BEEN FOUND
	SPA SNA CLA
	JMP	LRBLP		/NO, KEEP LOOKING
	CDFBUF		/YES, STORE TRAILING 0
	DCA I	RCBPTR
	CDFMYF
	JMP I	LRCBUF		/RETURN HOME NO ERRORS			/M025

LRBLP2,	AC7777			/CLEAR FLAG
	DCA	SSLBFD
	JMP	LRBLP3		/GO STORE CHAR

SSCNT,	0			/COUNTER FOR RECORD SIZE
SSLBFD,	0			/END OF RECORD FLAG
				/(-1 CLEAR, 0 LEFT BRACKET, 1 EOR)

SSRBST,	XX		/ STORES THE CHAR IN T1 INTO THE EDIT BUFFER	/M025
			/  FIELD. RETURNS IF CHAR STORED. ERROR EXIT IF	/M025
			/   NO MORE ROOM FOR CHAR.			/M025

	ISZ	SSCNT		/SEE IF ANY ROOM LEFT
	JMP	SSRBS1
	JMP	REVLGRC		/ ERROR - NO ROOM LEFT - RECORD EXCEEDS	/M025
				/  2500 CHARACTERS			/A025
SSRBS1,	TAD	T1		/ GET THE CHARACTER IN T1		/M025
	CDFBUF		/NOW TAKE A TRIP
	DCA I	RCBPTR		/TO STORE IT AWAY
	CDFMYF		/THEN COME HOME
	JMP I	SSRBST		/AND RETURN SOMEDAY

GETCHR,	XX		/THIS ROUTINE READS CHARS FROM A FILE.		/M025
			/ IT REMOVES ALL RULERS, PRINTER CONTROLS, AND
			/'FUNNY' SPACES AND LINE FEEDS.
			/CALLED BY:
			/JMS	GETCHR
			/EOF RETURN
			/REGULAR RETURN (AC CONTAINS CHAR)

	CLA
GTCHLP,	JMS	RDNXCH		/GET NEXT CHAR
	SPA SNA
	JMP I	GETCHR		/EOF (RETURN IS ZERO)
	DCA	T1		/SAVE CHAR
	TAD	T1
	AND	P177		/IGNORE HIGHS FOR NOW
	TAD	(-41		/SEE IF SPECIAL CHARACTER
	SPA
	JMP	SSPCHR		/MAYBE, LOOK DEEPER
	CLA
	TAD	T1		/GET CHAR BACK
	ISZ	GETCHR		/BUMP RETURN
RTNCHR,	JMP I	GETCHR		/RETURN					/M018

SSPCHR,	TAD	(25		/SEE IF A FF (14)
	SNA
	JMP	SSCPC		/YES, NOW CHECK IF SPECIAL
	TAD	(-2		/NO, WHAT ABOUT START OF RULER (16)
	SNA CLA
	JMP	SSDLRR		/YES, GO DELETE RULER
	TAD	T1		/GET CHAR BACK
	AND	(2000		/HIGH PART ON?
	SZA CLA
	JMP	GTCHLP		/YES, IGNORE CHARACTER
GTCHRT,	TAD	T1		/NO, MUST HAVE BEEN O.K. AFTER ALL
	ISZ	GETCHR		/BUMP RETURN
	JMP I	GETCHR		/AND GO

SSCPC,	TAD	T1		/SEE IF START OF CONTROL BLOCK		/M018
	TAD	(-1014		/GET NEGATIVE OF CONTROL BLOCK CHARACTER/M018
	SZA CLA			/IS IT THE START OF A CONTROL BLOCK?	/M018
	JMP	GTCHRT		/  NO: MUST HAVE BEEN NORMAL FF		/M018
									/A018
/***** HOOK MADE HERE TO CHK AND SERVE MATH CONTROL BLOCK  *****	/A018
									/A018
	JMP CNTROL		/  YES: CHECK IF MATH CONTROL BLOCK	/A018
									/A018
/***** END OF HOOK *********************************************	/A018
									/A018
SSCPC1,	JMS	RDNXCH		/GET A CHAR
	SPA SNA
	JMP I	GETCHR		/ERROR, EOF (RETURN IS NOT POSITIVE)
	TAD	(-1414		/SEE IF END YET
	SZA CLA
	JMP	SSCPC1		/NO, KEEP LOOKING
	JMP	GTCHLP		/YES, BACK TO NORMAL PROCESSING

SSDLRR,	JMS	RDNXCH		/GET A CHAR
	SPA SNA
	JMP I	GETCHR		/ERROR (RETURN IS NEGATIVE)
	TAD	(-17		/END OF RULER?
	SZA CLA
	JMP	SSDLRR		/NO, KEEP LOOKING
	JMP	GTCHLP		/YES, BACK TO NORMAL PROCESSING
/--------------
	PAGE

/****************************************************************************
/
/	W	A	R	N	I	N	G		/a003
/									/a003
/	THIS AREA BLASTED FOR MCS CHARACTERS IN NUMERIC FIELDS		/a003
/		See WPMTHL, maths hole, for code			/a003
/
/****************************************************************************

LPHOLE=.

NUMFLD,	0		/ NUMERIC FIELD FLAG				/A030
			/ 0= NOT A NUMERIC FIELD (<NAME>)		/A030
			/ 1= A NUMERIC FIELD   (<:NAME>)		/A030
LFLDNM,	XX		/THIS ROUTINE LOADS A FIELD NAME FROM AFTER THE	/M025
			/ '<' UNTIL THE FIRST '>' INTO THE GENERAL	/M025
			/  PURPOSE BUFFER. IT DOES A SKIP RETURN IF ALL	/M025
			/   O.K., AND A REGULAR RETURN IF AT END OF	/M025
			/    RECORD.  IF ERROR TAKE ERROR EXIT.  THIS	/M025
			/     ROUTINE MUST BE ENTERED WITH AC = 0!	/M025

	TAD	(GPBUF-1	/SET-UP PTR IN AUTO-INDEX
	DCA	GPPTR
	TAD	(-GPBSIZ-1	/SET-UP SIZE COUNTER			/M030
	DCA	SSCNT
	DCA	FNCNT		/Zero the absolute string length	/a040
	JMS	SSRBRD		/GET FIRS CHAR				/A030
	DCA	T1		/ STORE					/A030
	TAD	T1		/ GET BACK				/A030
	TAD	(-":+200	/					/A030
	SNA CLA			/IF ":"					/A030
	AC0001			/THEN NUMFLD = 1			/A030
	DCA	NUMFLD		/ELSE NUMFLD = 0			/A030
	JMP	LFNLP1		/CONTINUE PROCESSING FIRST CHAR		/A030
LFNLP,	JMS	SSRBRD		/GET NEXT CHAR
	DCA	T1		/SAVE IT
LFNLP1,	TAD	T1							/M030
	TAD	(-76		/SEE IF '>'
	SNA
	JMP	LFNDN		/YES, DONE FIELD
	TAD	(2		/SEE IF '<'
	SNA CLA
	JMP	REVLBFN		/ ERROR - '<' IN FIELD NAME		/M025
	ISZ	FNCNT		/Incrament the absolute string length	/a044
	TAD	DEADKEY		/Check dead key status			/a044
	SNA CLA			/Are we processing a dead key sequence?	/a044
	ISZ	SSCNT		/NO, SEE IF MORE THAN 30 PRINTING CHARS	/m044
	JMP	.+2
	JMP	REVLGFN		/ ERROR - FIELD NAME EXCEEDS 30 CHARS.	/M025
	TAD	T1		/GET BACK CHAR
	DCA I	GPPTR		/AND STORE IN STRING
	JMP	LFNLP		/LOOP BACK FOR MORE

LFNDN,	TAD	SSCNT		/GET COUNT OF WORDS USED
	TAD	(GPBSIZ+1	
	SNA CLA								/m044
	JMP	NULL		/EOR, JUST '<>' FOUND
/d044	DCA	FNCNT		/SAVE FN LENGTH
	DCA I	GPPTR		/STORE TRAILING 0
	ISZ	LFLDNM		/DO A SKIP RETURN
NULL,	JMP I	LFLDNM		/RETURN

XSCMP,	0		/DOES A MATCH OF AN ASCII AND AN ASCIZ STRING
			/RETURNS AC OF 0 IF FAILED AND -1 IF MATCHES
			/CALLED WITH AC EQUAL TO NO. OF CHARS. IN THE 1ST STRING (ASCII)
			/TO TRY TO MATCH. POSITIVE TO MAKE SURE MATCHED TO END
			/OF 2ND STRING, NEG. FOR DON'T CARE
			/JMS XSCMP
			/ADDR OF 1ST STRING -ASCII (ALWAYS THSFLD)
			/ADDR OF 2ND STRING -ASCIZ
			/FIELD FOR 2ND STRING
			/RETURN (TO THSFLD)
	SMA			/CHECK FOR TRAILING 0 ?
	JMP	XSCM1		/YES
	DCA	XSCNT		/NO, JUST STORE COUNT
	DCA	XSZFLG		/AND RESET FLAG				/m044
	JMP	XSCM2
XSCM1,	CIA			/NO. OF CHARS TO SEARCH
	DCA	XSCNT
	AC7777								/a044
	DCA	XSZFLG		/SET FLAG TO CHECK FOR TRAILING 0
XSCM2,	AC7777
	TAD I	XSCMP		/GET ADDR OF 1ST STRING
	DCA	TAI1		/SET-UP AUTO-INDEX
	ISZ	XSCMP		/MOVE TO NEXT ARG
	AC7777
	TAD I	XSCMP		/ADDR OF SECOND STRING
	DCA	TAI2
	ISZ	XSCMP
	TAD  I	XSCMP		/GET CDF FOR 2ND STRING
	DCA	XSCLP		/SET-UP TO EXECUTE
	ISZ	XSCMP		/MAKE SURE WE RETURN TO THE RIGHT PLACE
	TAD	XSCLP		/GET THE CDF BACK
	DCA	XSCLP1		/AND STORE CAUSE WE'LL NEED IT AGAIN
XSCLP,	0			/FOR THE CDF
	TAD I	TAI2		/CHAR FROM 2ND STRING
	CDFMYF		/BACK TO HOME FIELD
	SNA			/SEE IF END OF STRING
	JMP I	XSCMP		/YES, SO RETURN WITH 0 IN AC
	AND	P177		/NO, GET RID OF ALL CONTROL
/d044	IAC			/MAKE CHAR ONE LESS
	CMA			/AND NEGATE				/m044
	DCA	T1		/STORE IN TMP
	AC0001			/SET UP TO TEST FOR <?> WILD CARD
	TAD I	TAI1		/GET CHAR FROM 1ST STRING
	SNA			/WILD CARD CHAR ?
	JMP	XSCLP2		/YES, DO MATCH FOUND CODE
	TAD	T1		/NO, SUBTRACT 2ND STRING CHAR - 1
	SZA CLA			/ARE THEY THE SAME?
	JMP I	XSCMP		/NOPE, RETURN WITH A 0 IN AC
XSCLP2,	ISZ	XSCNT		/DID WE LOOK AT ENOUGH CHARS?
	JMP	XSCLP		/NO, COMPARE SOME MORE
	ISZ	XSZFLG		/YES, CHECK ASCIZ FLAG			/m044
/d044	SZA CLA
	JMP	XSCM3		/NOPE, JUST SET FOR SUCCESS
XSCLP1,	0			/YES, DO THE CDF
	TAD I	TAI2		/MAKE SURE WE'RE AT THE END
	CDFMYF		/BACK TO HOME FIELD
	SNA CLA			/0, FOR NOT AT THE END OF STRING
XSCM3,	AC7777			/ -1 FOR SUCCESS
	JMP I	XSCMP		/RETURN

XSCNT,	0
XSZFLG,	0

/ THIS ROUTINE IS USED TO INSURE THAT THE RECORD NUMBER COUNT (RECNUM),
/ THE RECORD PROCESSED COUNT (RECPRO), AND THE MERGED RECORD COUNT (SUCREC)
/ DOES NOT EXCEED THE LIMIT OF THE NUMBER OF RECORDS THAT WE CAN PROPERLY
/ DISPLAY (4095 DECIMAL, 7777 OCTAL).  IOA'S ABILITY TO PRINT DECIMAL NUMBERS
/ FROM OCTAL HAS A RANGE OF 0 - 4095 DECIMAL (0 - 7777 OCTAL).  THUS IF RECNUM
/ RECPRO, OR SUCREC REACH A VALUE OF 4095 DECIMAL (7777 OCTAL) WE WILL KEEP
/ IT AT THAT COUNT WITH OUT INCREMENTING IT TO ZERO.

INCNUM,	XX	/ INCREMENT NUMBER BUT NOT PAST 7777			/A042
	TAD I	INCNUM		/ PICK UP THE POINTER TO THE WORD	/A042
	DCA	T2		/  TO BE INCREMENTED AND THEN INCREMENT	/A042
	ISZ I	T2		/   THE WORD POINTED TO BY T2		/A042
	JMP	INCDON		/ IT'S OK, GO RETURN TO CALLER		/A042
	CMA			/ INCREMENT FAILED			/A042
	DCA I	T2		/ RESET THE COUNT BACK TO MINUS ONE	/A042
INCDON,	ISZ	INCNUM		/ BUMP RETURN ADDRESS OVER POINTER	/A042
	JMP I	INCNUM		/ RETRUN TO CALLER			/A042

/ WHEN CALLING ANY OF THE REV???? ERRORS YOU MUST ENTER WITH AC = 0!	/A025

REVLGNM,TAD	(EVLGNM-EVRBFD)	/ FIELD VALUE NUM. EXCEEDS 30 CHARS.	/A025
REVRBFD,TAD	(EVRBFD-EVLGFN)	/ '>' IN A FIELD			/A025
REVLGFN,TAD	(EVLGFN-EVLBFN)	/ FIELD NAME EXCEEDS 30 CHARACTERS	/A025
REVLBFN,TAD	(EVLBFN-EVCRBR)	/ '<' IN FIELD NAME			/A025
REVCRBR,TAD	(EVCRBR-EVPEOF)	/ TEXT BETWEEN RECORDS			/A025
REVPEOF,TAD	(EVPEOF-EVLGRC)	/ END OF FILE ERROR			/A025
REVLGRC,TAD	(EVLGRC)	/ RECORD EXCEEDS 2500 CHARACTERS	/A025
ERRHAN,	DCA	ERRNUM		/SAVE ERROR NUMBER			/M025
	AC7777		/GET -1 INTO THE AC				/A028
	JMP SELCTX	/BYPASS "DOMATH" IF ERROR ENCOUNTERED BY LP	/A028

ERRNUM,	0								/M025

ERRXIT,	CIFMNU			/ CALL REPORTER				/A025
	JMS I	OLAYCL							/A025
	11
	JMP	REPORT		/ GO REPORT RESULTS			/A025
/--------------
	PAGE

/DISPLAY THE RECORD NO. BEING PROCESSED					/M019
DISREC,	XX								/M019
	AC0001			/ SET RECORD NUMBER FOR OUTPUT		/A019
	TAD	RECNUM
	DCA	DISRE1		/ STORE NUMBER FOR OUTPUT		/A019

	CIFMNU								/A019
	JMS I	IOACAL							/A019
	0								/A019
	DISMSG			/ ADDRESS OF TEXT STRING TO OUTPUT	/A019
	0000			/ ^P - POSITION CURSOR TO HOME		/A019
DISRE1,	.-.			/ ^D - RECORD NUMBER TO OUTPUT		/A019
				/ ^L - ERASE TO END OF LINE		/A019
	0100			/ ^P - POSITION CURSOR (LINE 1, COL. 0)	/A019
				/ ^L - ERASE TO END OF LINE		/A019
	2700			/ ^P - POSITION CURSOR (LINE 27, COL. 0)/A042

	JMP I	DISREC		/RETURN
									/A019
DISMSG,	
IFDEF ENGLSH < TEXT '^P&RECORD BEING PROCESSED: ^D^L^P^L^P' >		/M042
IFDEF ITALIAN< TEXT '^P&RECORD IN ELABORAZIONE: ^D^L^P^L^P' >
IFDEF CANADA < TEXT "^P&ENR. EN COURS DE TRAITEMENT: ^D^L^P^L^P" >	/M042
IFDEF FRENCH < TEXT "^P&ENREGISTREMENT EN COURS : ^D^L^P^L^P" >		/M042
IFDEF DUTCH  < TEXT "^P&GEGEVENSGROEP VERWERKT: ^D^L^P^L^P" >		/M042
IFDEF GERMAN < TEXT "^P&VERARBEITETER SATZ: ^D^L^P^L^P" >		/M042
IFDEF NORWAY < TEXT "^P&FOREKOMSTER BEHANDLET: ^D^L^P^L^P" >		/M042
IFDEF SWEDSH < TEXT "^P&BEHANDLADE F\REKOMSTER: ^D^L^P^L^P" > /L.U.O	/M042
IFDEF DANISH < TEXT "^P&FOREKOMSTER BEHANDLET: ^D^L^P^L^P" >		/M042

/SUBROUTINE TO HANDLE UNBUNDLING - CHECK IF MATH  FEATURE IS ACTIVATED	/A020
/THIS ROUTINE IS CALLED WHEN A CONTROL BLOCK IS FOUND IN LIST 		/A020
/PROCESSING. IF THE MATH FEATURE IS ON THEN THE BLOCK IS PROCESSED, 	/A020
/AND IF IT IS NOT THEN AN EXIT IS DONE FROM "CHKMTH" TO THROW OUT THE 	/A020
/CONTROL BLOCK AND CONTINUE NORMAL LIST PROCESSING			/A020
/ROUTINE IS CALLED FROM INSIDE "CNTROL" ROUTINE				/A020

IFDEF UNBUND	<							/A020
CHKMTH,	XX		/CHECK MATH FEATURE ROUTINE			/A020
	CDFMNU		/SET TO MENU DATA FIELD				/A020
	TAD I (MUBUF+MNOPTC	/GET ACTIVE FEATURES CONTROL WORD	/A020
	CDFMYF		/RETURN TO LIST PROCESSING FIELD		/A020
	AND (MABIT	/GET ACTIVATED MATH FEATURE CONTROL WORD	/A020
	SZA CLA		/IS THE MATH FEATURE ACTIVATED?			/M027
	ISZ CHKMTH	/  YES: SKIP RETURN TO PROCESS LP CONTROL BLOCK	/M027
	JMP I CHKMTH	/  NO: NORMAL RETURN TO DUMP CTRL BLOCK &....	/M027
			/  ...RETURN TO REGULAR LP	 		/M027
		>	/END IFDEF UNBUND				/A020


/SUBROUTINE USED IN CONJUNCTION WITH LP MATH INTERFACE ROUTINE "CNTROL"	/A021
/CHECKS FOR END OF CONTROL BLOCK CHAR. AND TREATS IT ACCORDINGLY 	/A021
/THIS RTN CAN ONLY BE UNDERSTOOD WITHIN THE CONTEXT OF "CNTROL"		/A021
/NOTE: IN THIS ROUTINE THE "JMP EXITCB" TO EXIT VARIES WITH THE 	/A038
/      PSUEDO-CODE FOR "CNTROL". THIS IS DONE TO SAVE ON LOCATIONS	/A038
/      SPACE AND EXECUTION TIME. NORMALLY WOULD SAY THE FOLLOWING IN	/A038
/      PLACE OF "JMP EXITCB". 						/A038
/                  -------------
/                  -------------					/A038
/                  JMP EXITC1	(THIS WOULD REPLACE "JMP EXITCB")	/A038
/                  -------------					/A038
/          EXITC1, DCA ENDCBF	(THIS WOULD BE ADDED AT END OF "CHKEOB" /A038
/                  JMP NXCTRL   (THIS WOULD BE ADDED AT END OF "CHKEOB" /A038


CHKEOB,	XX		/"END OF BLOCK" CHAR SERVICE ROUTINE		/A021
	TAD T1		/GET BACK CHAR JUST READ IN FROM CTRL BLOCK	/A021
	TAD (-1414	/GET NEGATIVE OF END OF CONTROL BLOCK CHAR	/A021
	SZA CLA		/IS IT THE END OF THE CONTROL BLOCK?		/A021
	JMP I CHKEOB	/  NO: GO CONTINUE NORMAL PROCESSING OF BLOCK	/A021
	TAD STRTLN	/  YES: GET "START OF NEW LINE" FLAG		/A021
	SNA CLA		/IS IT THE START OF A NEW LINE?			/A021
	JMP EXITCB	/  YES: GO EXIT CONTROL BLOCK PROCESSING	/A021
	JMP CTLOVR	/  NO: GO CONVERT CHAR, SET FLAG, & PROCESS	/A021

/SUBROUTINE TO TAKE JUSTIFIED SPACE (ECJSPC) AND WRAPPED LINE (ECWWLN)	/A022
/CHARACTERS AND STRIP THEM OUT BEFORE PUTTING CONTROL BLOCK CHARACTERS	/A022
/INTO LINEBUFFER (LNEBUF) IN MATH FIELD. THIS ROUTINE UNDERSTOOD IN  	/A022
/CONTEXT OF "CNTROL" L.P./MATH INTERFACE ROUTINE			/A022

STRPCH,	XX		/STRIP WRAPS & SOFT SPACES ROUTINE		/A022
	TAD (-ECWWLN	/GET NEGATIVE OF SOFT RETURN			/A022
	TAD T1		/GET CONTROL BLOCK CHAR READ FROM FILE		/A022
	SNA		/IS IT A WRAPPED RETURN?			/A022
	JMP CATCH1	/  YES: DUMP IT & GO READ IN NEXT CHAR		/A022
	TAD (ECWWLN-ECJSPC	/  NO: RESET CHAR & GET SOFT SPACE	/A022
	SNA 		/IS IT A JUSTIFIED SPACE?		/A022	/M033
	JMP CATCH1	/  YES: DUMP IT & GO READ IN NEXT CHAR		/A022
	TAD (ECJSPC-ECHYLN	/  NO: RESET & GET SOFT RTN WITH HYPHEN	/A033
	SNA CLA		/IS IT A SOFT RETURN WITH HYPHEN?		/A033
	JMP CATCH1	/  YES: DUMP IT & GO READ IN NEXT CHAR		/A033
	JMP I STRPCH	/  NO: RETURN TO CALLER TO ENTER CHAR IN LNEBUF /A022


/SUBROUTINE USED TO THROW OUT A CONTROL BLOCK IF IT IS NOT MATH.	/A023
/UNDERSTOOD IN THE CONTEXT OF "CNTROL" L.P./MATH INTERFACE ROUTINE	/A023

JNKBLK,	XX		/DUMP NON-MATH CONTROL BLOCK - ROUTINE		/A023
	CLA		/CLEAR AC					/A023
	TAD ENDCBF	/GET "END OF CONTROL BLOCK" FLAG		/A023
	SNA CLA		/IS IT THE END OF THE BLOCK?			/A023
	JMP EXTJNK	/  YES: GO EXIT					/A023
ENDBLK,	JMS RDNXCH	/  NO: GO READ IN NEXT CHAR			/A023
	SPA SNA		/IS IT AN "END OF FILE" CHAR?			/A023
	JMP RTNCHR	/  YES: RETURN TO CALLER WITH EOF ERROR		/A023
	TAD (-ECPCT2	/  NO: ADD NEGATIVE OF "END OF CTRL BLOCK" CHAR	/A023
	SZA CLA		/IS IT THE END OF THE CONTROL BLOCK?		/A023
	JMP ENDBLK	/  NO: DUMP CHAR & GO GET ANOTHER CHAR		/A023
EXTJNK,	JMP I JNKBLK	/  YES: GO EXIT TO CONTINUE NORMAL L.P.		/A023

NUMCMP,	0		/COMPARES TWO NUMBERS OF EQUAL LENGTH
			/AND DETERMINES IF THEY ARE EQUAL OR WHICH IS LARGER.
			/FIRST NUMBER (IN ASCII) IS POINTED BY SPCSTR.
			/SECOND NUMBER (ASCIZ) IS IN THE GPBUF BUFFER.
			/CALLED BY:
			/JMS	NUMCMP
			/RETURN (AC = 0 MEANS NUMBERS EQUAL,
			/	AC = +1 MEANS NUMBER 2 > NUMBER 1,
			/	AC = -1 MEANS NUMBER 2 < NUMBER 1)

	AC7777			/SET UP PTR TO FIRST NUMBER
	TAD	SPCSTR		/IN AUTO-INDEX
	DCA	TAI1
	TAD	NUMFLD		/ IF NUMERIC COMPARE ( <:NAME> )	/A030
	SZA CLA			/ THEN					/A030
	JMP	NUMCM1		/   USE BCD COMPARE ROUTINE 		/A030

	TAD	(GPBUF-1	/SET UP PTR TO NUMBER 2
	DCA	TAI2		/IN AUTO-INDEX
NMCMLP,	TAD I	TAI2		/GET A CHAR
	SNA			/ NULL ?
	JMP I	NUMCMP		/YES, RETURN WITH NUMBERS EQUAL
	CIA			/NO, SUBTRACT FROM
	TAD I	TAI1		/FIRST NUMBER
	SNA			/SAME ?
	JMP	NMCMLP		/YES, KEEP GOING
	SMA CLA			/NO, SET AC
	AC7776			/-1 FOR LESS THAN
	IAC			/+1 FOR GREATER THAN
	JMP I	NUMCMP		/AND RETURN

/THIS IS FORM COMPARING NUMBERS THAT ARE IN NUMERIC FIELDS LIKE <:A>	/A030
/ AS OPPOSED TO <A>							/A030

NUMCM1,	TAD (BCDAR2-1	/GET ADDRESS OF PLACE FOR BCD IN MATH FIELD	/A030
	DCA	TAI2	/ AND PUT IN AUTO INCREMENT REGISTER		/A030
	TAD	(-6	/ GET SIZE OF PACKED BCD WORD			/A030
	DCA	T1	/ AND INITIALIZE LOOP COUNTER			/A030
NUMCM2,	TAD I	TAI1	/ LOOP; GET BCD VALUE FORM SPEC TABLE		/A030
	CDFMTH		/						/A030
	DCA I	TAI2	/  AND PUT IN MATH FIELD			/A030
	CDFMYF		/						/A030
	ISZ	T1	/ 						/A030
	JMP	NUMCM2	/ END_LOOP					/A030

	CIFMTH		/ NOW CALL ARITHMETIC COMPARE ROUTINE IN MATH	/A030
	JMS	BCDCOM	/  FIELD					/A030
		BCDAR1	/   ADDRESS OF NUMBER FROM SPEC DOC		/A030
		BCDAR2	/   ADDRESS OF NUMBER FROM LIST 		/A030
	JMP I	NUMCMP	/RETURN (AC = 0 MEANS NUMBERS EQUAL,		/A030
			/	AC = +1 MEANS NUMBER 2 > NUMBER 1,	/A030
			/	AC = -1 MEANS NUMBER 2 < NUMBER 1)	/A030
/--------------
	PAGE

	/THIS ROUTINE CHECKS TO SEE IF THE RECORD NUMBER IS WITHIN	/A042
	/THE RANGE OF THE FROM - TO SETTINGS.  IT ALSO CHECKS TO SEE	/A042
	/IF THE HALT FLAG IS SET BY THE USER PRESSING GOLD-HALT		/A042
	/	CALLED BY:						/A042
	/	JMS	CHKREC						/A042
	/	SKIP RECORD RETURN					/A042
	/	DONE ALL RECORDS RETURN	OR HALT FLAG SET RETURN		/A042
	/	PROCESS RECORD RETURN					/A042

CHKREC,	XX								/A042
	CDFSYS			/ CHANGE TO THE SYSTEM FIELD		/A042
	TAD I	HLTFLG		/ PICK UP THE HALT FLAG			/A042
	CDFMYF			/ CHANGE BACK TO OUR FIELD		/A042
	SZA CLA			/ SKIP IF HALT FLAG IS NOT SET		/A042
	JMP	CHKPRC		/ SET, RETURN WITH NO MORE RECORDS	/A042
	TAD	FRREC		/ PICK UP THE FROM RECORD COUNT		/A042
	CIA STL			/ NEGATE IT AND SET THE LINK		/A042
	TAD	RECNUM		/ COMBINE WITH CURRENT RECORD NUMBER	/A042
	SZL CLA			/ SKIP IF ABOVE LOWER RANGE		/A042
	JMP	CHKXIT		/ TOO LOW, SKIP THIS RECORD		/A042
	ISZ	CHKREC		/ BUMP RETURN ADDRESS			/A042
	TAD	TOREC		/ GET THE RECORD NUMBER TO PROCESS UP TO/A042
	SNA			/ IS TO-RECORD NUMBER ZERO ?		/A042
	JMP	CHKPRC		/ YES, GO TO PROCESS RECORD RETURN	/A042
	CIA CLL			/ NEGATE IT AND CLEAR THE LINK		/A042
	TAD	RECNUM		/ COMBINE WITH CURRENT RECORD NUMBER	/A042
	SNL CLA			/ IF LINK IS SET, THEN WE ARE ALL DONE	/A042
CHKPRC,	ISZ	CHKREC		/ BUMP RETURN PAST ALL DONE RETURN	/A042
CHKXIT,	JMS	INCNUM		/ BUMP THE RECORD COUNT TO NEXT RECORD	/A042
	RECNUM			/ POINTER TO THE RECORD NUMBER		/A042
	JMP I	CHKREC		/ RETURN TO CALLER			/A042

TOREC,	0
FRREC,	0

NUM,			/LOADS A STRING FROM RECBUF INTO GPBUF REMOVING	/M025
			/ALL NON-NUMERIC CHARS. AND ALL LEADING ZEROES.	/M025

	CLA
	TAD	LDNMFL		/HAVE WE BEEN HERE BEFORE ?
	SZA CLA
	JMP	NUM1		/ YES - SO GET OUT!			/M025
	ISZ	LDNMFL		/NO, MAKE SURE WE DON'T COME AGAIN
	TAD	(GPBUF-1	/SET UP AUTO-INDEX PTR
	DCA	GPPTR
	TAD	(GPBSIZ+1	/AND COUNTER
	CIA
	DCA	NUMSIZ
	AC7777			/RESET REC BUFFER PTR TO BEGINNING OF FIELD
	TAD	FDSTRT
	DCA	RCBPTR
	TAD	(SPA SNA)	/SET TO IGNORE LEADING ZEROES
	DCA	NUM4							/M025
	TAD	NUMFLD		/IF NUMERIC FIELD  ( <:NAME> )		/A030
	SZA CLA								/A030
	JMP	NUM6		/THEN HANDLE REAL NUMBER		/A030
NUM3,	JMS	SSRBRD		/GET A CHAR				/M025
	TAD	(-74		/SEE IF '<' ?
	SNA
	JMP	NUM5		/YES, ALL DONE				/M025
	TAD	(-2		/NO, SEE IF '>' ?
	SNA			/ SKIP IF: NOT A '<'			/M025
	JMP	REVRBFD		/ ERROR - '>' IN A FIELD		/M025
	TAD	(4		/NO, SEE IF ASCII 9 OR LESS
	SMA
	JMP	NUM3		/NO, SKIP IT				/M025
	TAD	(12		/YES, SEE IF ASCII 0 OR MORE
NUM4,	XX			/MODIFIED TO IGNORE LEADING ZEROES	/M025
	JMP	NUM3		/SKIP CHAR				/M025
	TAD	(60		/MAKE ASCII AGAIN
	ISZ	NUMSIZ		/SEE IF ROOM FOR CHAR
	JMP	NUM2
	CLA CLL								/A025
	JMP	REVLGNM		/ ERROR - FIELD VALUE NUMBER EXCEEDS 30	/M025
				/         CHARACTERS			/A025
NUM2,	DCA I	GPPTR		/STORE CHAR
	TAD	(SPA		/TURN OFF ZERO SUPRESSION
	DCA	NUM4							/M025
	JMP	NUM3		/GET ANOTHER CHAR			/M025

NUM5,	TAD	NUMSIZ		/CALCULATE SIZE OF NUMBER
	TAD	(GPBSIZ+1
	DCA	NUMSIZ		/AND SAVE IT
	DCA I	GPPTR		/STORE TRAILING ZERO
NUM1,	JMP	ENUM		/ GO SEE IF EXACT COMPARE		/M025

NUM6,	JMS	LDFLD		/ LOAD NUMBER INTO TOKVAL BUFFER IN	/A030
				/ MATH FIELD				/A030
	JMP 	ORLP		/   NO NUMBER IN FIELD SO FAIL ON MATCH	/A030
	JMS	TOKOUT		/ OUTPUT TRAILING ZERO IN TOKVAL	/A030
	CIFMTH			/ CALL ASCII TO BCD ROUTINE IN MATH FLD	/A030
	JMS	ASCBCD		/					/A030
		TOKVAL		/   ADDRESS OF ASCII (IN MATH FIELD)	/A030
		BCDAR1		/   ADDRESS OF BCD OUTPUT (IN MATH FLD)	/A030
	JMP	ABERR		/ INVALID NUMBER SO FAIL MATCH		/A036
				/    CHECK NEXT OR GROUP		/A030
	AC0006			/ MAKE NUMBER SIZE = LENGTH OF PACKED/A030/M036
	DCA	NUMSIZ		/   SO IT IS SAME AS MLEN AND ELEN	/A030
	JMP	ENUM		/ NOT GO DO COMPARES			/A030

NUMSIZ,	0
LDNMFL,	0

TRUE,	TAD I	PTYWD		/TRUE, GET TYPE WORD
	CLL RTL			/SEE WHICH WAY TO SET SIGN BIT
	SZL
	JMP	TRUFLS		/MUST WANT IT SET TO FALSE (1)
	RAR			/OTHERWISE, GET IN POSITION
	CLL RAR			/AND SET SIGN BIT TO TRUE (0 - POSITIVE)
TRUE1,	DCA I	PTYWD		/AND STORE BACK
NXTSPC,	TAD	NXTSPR		/GET PTR TO NEXT SPEC
	SNA			/LAST ONE?
	JMP	FNLP		/YES, NEXT FIELD
	TAD	(-1		/NO, MAKE THIS SPEC
	JMP	FNLP2

TRUFLS,	RAR			/GET IN POSITION
	STL RAR			/AND SET SIGN BIT TO FALSE (1 - NEGATIVE)
	JMP	TRUE1		/AND STORE IT

PTYWD,	0
/--------------
	PAGE


/++
/		LIST PROCESSING CONTROL BLOCK EVALUAION CODE
/
/FUNTIONAL DESCRIPTION:	"CNTROL"
/
/			PSUEDO-CODE DESCRIPTION:
/
/ SET END_OF_CONTROL_BLOCK FLAG = FALSE
/ IF MATH FEATURE NOT ACTIVE
/    THEN DUMP CONTROL BLOCK
/         RETURN TO NORMAL L.P. PROCESSING
/    ELSE SET CONTROL_BLOCK_FIRST_LINE FLAG = TRUE
/ DO WHILE END_OF_CONTROL_BLOCK FLAG = FALSE
/    SET START_OF_NEW_LINE FLAG = TRUE
/    INIT INPUT LINE BUFFER IN MATH FIELD
/    DO WHILE START_OF_NEW_LINE = FALSE
/       GET CHAR FROM RECORD
/       IF CHAR = EOF
/          THEN RETURN TO CALLER WITH EOF ERROR
/          ELSE SAVE CHAR
/               CASE OF CHAR =
/
/                  SPECIAL "END OF CTRL BLOCK" CHARACTERS:
/                    IF START_OF_NEW_LINE = FALSE
/                       THEN SET END_OF_CONTROL_BLOCK FLAG = FALSE
/                       ELSE SET "END OF CTRL BLOCK" CHAR = HARD RETURN
/                       ENDIF
/
/                  START OF RULER CHAR:
/                    DUMP RULER CHARACTERS
/                    RETURN TO GET NEXT CHAR
/
/                  SPECIAL CHAR:
/                    IF START_OF_NEW_LINE = TRUE
/                       THEN DUMP SPECIAL CHAR
/                            RETURN TO GET NEXT CHAR
/                       ENDIF
/
/                  SOFT WRAP OR JUSTIFIED SPACE:
/                    DUMP CHARACTER
/                    RETURN TO GET NEXT CHAR
/
/                  END PARAGRAPH OR CENTERED LINE:
/                    SET CHAR = HARD RETURN
/
/                  END CASE
/
/                PUT CHAR INTO INPUT LINE BUFFER
/                CASE RETURN FROM MATH =
/
/                  SINGLE SKIP RETURN:
/                    PASS RETURNED ERROR NUMBER TO ERROR HANDLER
/
/                  DOUBLE SKIP RETURN:
/                    THROW OUT CONTROL BLOCK BECAUSE IT IS NOT MATH BLOCK
/
/                  TRIPLE SKIP RETURN:
/                    IF LAST CHAR PUT IN INPUT LINE BUFFER = HARD RETURN
/                       THEN GO TO MATH & PROCESS LINE
/                            CASE RETURN FROM MATH =
/
/                              REGULAR RETURN:
/                                SET START_OF_NEW_LINE FLAG = TRUE
/
/                              SINGLE SKIP RETURN:
/                                PASS RETURNED ERROR NUMBER TO ERROR HANDLER
/
/                              DOUBLE SKIP RETURN:
/                                THROW OUT BLOCK CAUSE NOT MATH
/
/                              END CASE
/                       ENDIF
/                    END CASE
/          ENDIF
/       END DO
/    END DO
/ RETURN TO NORMAL LP PROCESSING
/ END PSUEDO-CODE
/
/CALLING SEQUENCE:	.
/
/NOTE; THE HOOK IS MADE FROM LIST PROCESSING WITHIN THE "GETCHR" RTN
/WHERE THE CODE CHECKS FOR A PRINT CONTROL BLOCK. THE FOLLOWING SHOWS
/EXACTLY WHERE THIS IS DONE:
/
/GETCHR,0   .		/THIS ROUTINE READS CHARS FROM A FILE
/           .
/           .
/RTNCHR,JMP I GETCHR
/           .
/           .
/           .
/SSCPC,	TAD TI		/SEE IF START OF CONTROL BLOCK
/	TAD (-1014	/GET NEGATIVE OF CONTROL BLOCK CHARACTER
/	SZA CLA		/IS IT START OF CONTROL BLOCK?
/	JMP GTCHRT	/  NO: MUST HAVE BEEN NORMAL FF
/*******JMP CNTROL******/  YES: HOOK MADE HERE TO CONTROL BLOCK PROCESSING ***
/           .
/
/INPUT PARAMETERS:	FSTLNE,MNOPTC,MABIT,T1
/
/IMPLICIT INPUT:	ENDCBF, STRTLN, CALLS TO RTRN1, RTRN2, RTRN3, RDNXCH
/
/OUTPUT PARAMETERS:	(TO THE MATH MODULE)
/
/IMPLICIT OUTPUT:	ENDCBF,STRTLN,
/
/COMPLETION CODE:	
/
/	"JMP RTNCHR" - RETURN THRU GETCHR TO CALLER IN CASE OF EOF ERROR
/	"JMP ERRHAN" - PASSES ENCOUNTERED MATH ERRORS BACK THRU ERROR HANDLER
/	"JMP GTCHLP" - RETURN TO GETCHR RTN TO CONTINUE NORMAL PROCESSING ONCE
/		       BLOCK PROCESSING COMPLETED.
/
/SIDE EFFECTS:		SET UP OF DATA STRUCTURES & PARAMETERS IN THE MATH
/			MODULE; "CNTROL" INTERACTS DIRECTLY AND INDIRECTLY WITH
/			THE MATH.
/			THIS CODE IS USED IN LIST PROCESSING TO PARSE THE
/			CONTROL BLOCKS IN A LIST. IT CHECKS WHETHER IT IS A
/			MATH CONTROL BLOCK AND, IF SO, WHAT CONTROL WORDS ARE
/			USED IN THE BLOCK. IT ALSO MAKES USE OF THE COMMAND
/			PARSER AND TRANSLATOR TO PERFORM THIS PROCESSING.
/
/--

	/LIST PROCESSING MATH CONTROL BLOCK PROCESSING CODE.
	/THIS CODE HANDLES ONLY CHARACTERS WITHIN THE CONTROL BLOCK

	/VALUES USED IN CONTROL BLOCK EVALUATION CODE

ENDCBF,	0		/"END OF CONTROL BLOCK"	FLAG
STRTLN,	0		/"START OF NEW LINE" FLAG

		/CONTROL BLOCK MATH EVALUATION CODE

/NOTE: WITHIN THE LIST PROCESSING CONTROL BLOCK CODE, "CIF'S" MADE TO THE MATH
/FIELD ARE HANDLED IN THE CALLED MATH FIELD ROUTINE SO AS TO AUTOMATICALLY
/RETURN PROGRAM CONTROL TO THE LIST PROCESSING FIELD ONCE THE CALLED MATH
/FIELD ROUTINE HAS BEEN EXECUTED.

	/FIRST SET "END OF CONTROL BLOCK" FLAG ACCORDINGLY		

CNTROL,	AC0001		/PUT 1 IN THE AC
	DCA ENDCBF	/SET "END OF CONTROL BLOCK" FLAG = FALSE

	/BEFORE PROCESSING CONTROL BLOCK SEE IF UNBUNDLING IS DEFINED	/A020

IFDEF UNBUND	<							/A020

	JMS CHKMTH	/IF UNBUNDLING DEFINED THEN GO SEE IF MATH	/A020
			/FEATURE IS ACTIVATED. IF IT IS THEN ROUTINE	/A020
			/WILL SKIP RETURN HERE TO PROCESS CONTROL BLOCK	/M027
			/IF NOT THEN THE BLOCK IS DUMPED AND A RETURN 	/A020
			/IS DONE TO NORMAL LIST PROCESSING		/A020
	JMP ENDPCB	/RETURN HERE FROM "CHKMTH" IF NOT MATH - DUMP 	/A027
			/...BLOCK & GO BACK TO NORMAL LIST PROCESSING	/A027

		>	/END IFDEF UNBUND				/A020

		/SKIP RETURN HERE FROM "CHKMTH" IF MATH ACTIVATED	/A027
		/GO INITIALIZE "CONTROL BLOCK FIRST LINE" FLAG

	CDFMTH		/CHANGE DATA FIELD REGISTER TO MATH FIELD
	DCA I (FSTLNE	/GO SET "CONTROL BLOCK FIRST LINE" FLAG = TRUE
	CDFMYF		/RESET TO LP DATA FIELD

	/CHECK FOR END OF CONTROL BLOCK. IF NOT END OF BLOCK THAN
	/INITIALIZE "START OF NEW LINE" FLAG AND MATH FIELD INPUT
	/LINE BUFFER POINTER

NXCTRL,	TAD ENDCBF	/GET "END OF CONTROL BLOCK" FLAG
	SNA CLA		/IS IT THE END OF THE CONTROL BLOCK?
	JMP EXITCB	/  YES: GO EXIT CONTROL BLOCK PROCESSING CODE
	DCA STRTLN	/  NO: SET "START OF NEW LINE" FLAG = TRUE	
	CIFMTH		/CHANGE PROGRAM CONTROL TO MATH FIELD
	JMS RTRN1	/INITIALIZE INPUT LINE BUFFER POINTER IN MATH FIELD

	/PROCESS CHARACTERS WITHIN THE CONTROL BLOCK

CATCH1,	JMS RDNXCH	/GET A CHARACTER FROM THE FILE
	SPA SNA		/IS THE CHARACTER RETURNED AN END OF FILE?
	JMP RTNCHR	/  YES: RETURN TO CALLER WITH EOF ERROR
	DCA T1		/  NO: SAVE IT

	/THE FOLLOWING CALL IS MADE TO "CHKEOB" AS A SUBROUTINE TO 	/A021
	/HANDLE SPECIAL CASES OF "END OF CTRL BLOCK" CHAR		/A021
	/A RETURN IS DONE BACK HERE IF NONE OF THE SPECIAL CASES	/A021
	/WERE MET. OTHERWISE THEY WILL BE TREATED DIRECTLY FROM THAT	/A021
	/ROUTINE. (DONE THAT WAY DUE TO LACK OF SPACE ON THIS PAGE)	/A021

	JMS CHKEOB	/CHECK ON SPECIAL "END OF CTRL BLOCK" CASES	/A021

	/RETURN TO CONTINUE PROCESSING IF ALL IS WELL			/A021
	/CHECK FOR RULERS IN THE BLOCK

	TAD T1		/GET CHARACTER BACK
	TAD (-16	/GET NEGATIVE OF START OF RULER
	SNA CLA		/IS IT THE START OF A RULER?

	JMP ENDRUL	/  YES: GO DUMP RULER CHARACTERS

			/  NO: THEN CHECK FOR START OF NEW LINE

	TAD STRTLN	/GET "START OF NEW LINE" FLAG
	SZA CLA		/IS IT THE START OF A NEW LINE?
	JMP INPCHK	/  NO: THEN CONTINUE TO PROCESS CHARACTER	/A022

	/SCREEN OUT LEADING SPECIAL CHARACTERS FROM INPUT LINE

	TAD T1		/  YES: GET INPUT CHAR BACK
	AND P177	/SCREEN OUT HIGH BITS
	TAD (-41	/GET NEGATIVE OF UPPER LIMIT OF SPECIAL CHARACTERS
	SPA 		/IS IT A SPECIAL CHARACTER?
	JMP CATCH1	/  YES: DUMP IT AND READ IN NEXT CHARACTER
	DCA STRTLN	/  NO: SET "START OF NEW LINE" FLAG = FALSE

	/GO STRIP OUT ANY SOFT RETURNS AND/OR SOFT SPACES		/A022

INPCHK,	JMS STRPCH	/GO DUMP WRAPS & JUSTIFIED SPACES		/A022

	/PUT CHARACTER READ IN FROM FILE INTO INPUT LINE BUFFER IN MATH FIELD

INPCHR,	TAD T1		/GET CHARACTER BACK INTO AC
	DCA PASOVR	/SAVE IT IN LOCATION AFTER CALL TO MATH FLD TO PASS IT
	CIFMTH		/SET PROGRAM CONTROL TO MATH FIELD
	JMS RTRN2	/AND GO PUT INPUT CHARACTER INTO INPUT LINE BUFFER
PASOVR,	0		/CONTAINS INPUT CHAR TO PASS TO RTRN2 RTN IN MATH FLD

	JMP ERRHAN	/SKIP RETURN TO HERE FROM RTRN2 IF THERE WAS A 	/A025A
			/MATH FIELD INPUT LINE BUFFER OVERFLOW WITHIN 	/A025A
			/THE CONTEXT OF A MATH CONTROL BLOCK		/A025A
			/THE AC CONTAINS THE PASSED ERROR NUMBER	/A025A

	JMP ENDPCB	/DOUBLE SKIP RETURN DONE HERE FROM "RTRN2" IF
			/INPUT LINE BUFF OVERFLOW AND NOT A MATH CONTROL BLOCK
			/ - PROCEED TO THROW OUT THE CONTROL BLOCK.

	TAD T1		/TRIPLE SKIP RETURN FROM "RTRN2" DONE HERE IF INPUT
			/CHARACTER PLACED INTO INPUT LINE BUFFER WITHOUT AN
			/OVERFLOW. CONTINUE TO SEE IF LAST CHAR READ IN IS A
			/LINEFEED (I.E. HARD RETURN).

	TAD (-ECNWLN	/GET NEGATIVE OF NEW LINE (HARD RETURN)
	SZA CLA		/IS IT THE END OF THE LINE BEING READ IN?
	JMP CATCH1	/  NO: GO GET NEXT CHARACTER
	CIFMTH		/  YES: GO TO MATH FIELD TO PROCESS INPUT LINE
	JMS RTRN3	/PROCESS STRING OF CHAR JUST READ INTO INPUT LINE BUFF
	JMP NXCTRL	/GO START NEW INPUT LINE

	/NOTE: IF AN ERROR IS ENCOUNTERED IN THE MATH CODE WHILE PROCESSING
	/THE MATH CONTROL BLOCK THEN A SKIP RETURN IS DONE FROM "JMS RTRN3"
	/WITH ERROR NUMBER IN THE AC.

	JMP ERRHAN	/GO PROCESS ERROR RETURNED FROM THE MATH MODULE

	/NOTE: IF THE ABOVE "JMS RTRN3" ROUTINE FINDS NO MATCH UP IN THE
	/SYMBOL TABLE WITH THE INPUTTED CONTROL WORD, AND IT IS THE FIRST LINE
	/OF CHARACTERS OF THE CONTROL BLOCK THAN, WHEN RETURNING TO
	/LIST PROCESSING,  A DOUBLE SKIP RETURN IS DONE
	/TO THE FOLLOWING CODE IN ORDER TO PROCESS AS NOT BEING A "MATH"
	/CONTROL BLOCK.

	/THROW OUT CONTROL BLOCK IF IT IS NOT MATH, THEN RETURN TO L.P.

ENDPCB,	JMS JNKBLK							/M023

	/A NORMAL RETURN IS DONE FROM "ENDPCB" IF NO PROBLEM		/M023
	/IS ENCOUNTERED WHILE STRIPPING OUT NON-MATH CTRL BLOCK		/M023
	/OTHERWISE SPECIAL CASE OF EOF HANDLED FROM "JNKBLK"		/M023

EXITCB,	JMP GTCHLP	/GO BACK TO CONTINUE NORMAL PROCESSING

	/RTN TO PROCESS END OF CONTROL BLOCK CHAR IN CONTROL BLOCK. THIS IS
	/DONE IN THE CASE WHERE AN "END OF CONTROL BLOCK" CHAR TERMINATES
	/THE BLOCK WHILE NOT PRECEDED BY A "LINE FEED" (I.E. HARD RETURN)
	/CHAR. IT IS REPLACED BY A HARD RETURN TO ACCOMODATE THE "LEXIC"
	/ROUTNE IN THE MATH AREA.

CTLOVR,	TAD (ECNWLN	/GET ASCII FOR LINEFEED (HARD RETURN) CHARACTER

		/CHANGE END OF CONTROL BLOCK CHAR WITH A HARD RETURN
		/CHAR TO MAKE INPUT LINE COMPATIBLE WITH LEXIC SCANNER

	DCA T1		/REPLACE END OF CONTROL BLOCK CHAR WITH IT
	DCA ENDCBF	/SET "END OF CONTROL BLOCK" FLAG = TRUE
	JMP INPCHR	/GO PUT LINEFEED CHAR INTO INPUT BUFFER & PROCESS LINE

	/THIS CODE THROWS OUT ANY RULERS IN THE PRINT CONTROL BLOCK

ENDRUL,	JMS RDNXCH	/READ IN NEXT CHARACTER FROM FILE
	SPA SNA		/IS THERE AN ERROR CONDITION?
	JMP RTNCHR	/ABOVE "JMP GETCHR" SHOULD BE AN INDIRECT. BUT  /A038
			/THIS WOULD CAUSE AN ERROR SINCE "GETCHR" IS OFF/A038
			/PAGE. THEREFORE THE RETURN HAS BEEN DONE THRU A/A038
			/LABEL ON THE SAME PAGE AS "GETCHR"		/A038
	TAD (-17	/  NO: GET NEGATIVE OF END OF RULER CHARACTER
	SZA CLA		/IS IT THE END OF THE RULER?
	JMP ENDRUL	/  NO: TRY AGAIN
	JMP CATCH1	/  YES: GO GET A CHARACTER FROM THE FILE


/ GET_FIELD_VALUE
/ (NOTE: THIS ROUTINE IS EXITED FROM NXTCHR IN NORMAL CIRCUMSTANCES )
/ (* THIS ROUTINE WILL PUT THE FIRST CONTIGUOS STRING OF PRINTABLE CHARACTERS
/    FROM THE FIELD VALUE INTO A BUFFER TO BE USED IN CALLING THE ASCII TO
/    BCD ROUTINE *)

LDFLD,	XX
	TAD	(TOKVAL-1	/ INITIALIZE POINTERS
	DCA	TAI2		/  INIT POINTER TO OUTPUT IN MATH FIELD
	TAD	(-GPBSIZ-1						/M024
	DCA 	T1		/  INIT COUNTER TO MAX. CHARS ALLOWED

LDFLD1,	JMS	NXTCHR		/ WHILE NEXT_CHAR NOT PRINTABLE DO
	JMP	LDFLD1		/     GET NEXT_CHAR
				/ END_WHILE

	ISZ	LDFLD		/ SET UP SKIP RETURN TO SHOW WE DON'T HAVE
				/ A NULL FIELD VALUE
	JMS	TOKOUT		/ OUTPUT FIRST PRINTABLE CHARACTER
	ISZ	T1		/ INCREMENT COUNTER

LDFLD2,	JMS	NXTCHR		/ LOOP  GET_CAHR
	JMP	LDFLD3		/ EXIT IF NEXT_CHAR NOT PRINTABLE
	JMS	TOKOUT		/     PUT CHARACTER INTO TOKVAL
	ISZ	T1		/ EXIT IF TOO MANY CHARACTERS
	JMP	LDFLD2		/ END-LOOP

	JMP	REVLGNM		/ ERROR - FIELD VALUE NUMBER EXCEEDS 30	/M025
				/         CHARACTERS

LDFLD3,	JMS	GFDEND		/ READ TO END OF CURRENT FIELD VALUE
	JMP I	LDFLD		/ EXIT ROUTINE

NXTCHR,	0		/ READS CHAR FROM EDIT BUFFER, STRIPS MODE BITS
			/ REGULAR RETURN IF UNPRINTABLE CHARACTER (I.E. LESS
			/ THAN 41 OCTAL)
			/ SKIP RETURN IF A PRINTABLE CHARACTER
			/ EXITS LDFLD IF '<' (END OF FIELD) FOUND

	JMS	SSRBRD	/ CALL GET_CHAR ROUTINE (MODE BITS ARE STRIPED)
	TAD	(-74	/ IS IT A '<'?
	SNA
	JMP I	LDFLD	/   YES SO EXIT LDFLD ROUTINE (NOTE: LDFLD CALLED US)
	TAD	(74-76	/   NO, IS IT A '>'
	SNA
	JMP	REVRBFD	/ ERROR - '>' FOUND IN FIELD

/d003	TAD	(76-41	/	NO, IS IT A PRINTABLE CHARACTER?

	TAD	(76-ECSTOV)	/ Test for start of dead key sequence	/a003
	JMS	NXTMCT		/ Test for a multi-national character	/a003
	TAD	(ECSTOV)	/ Returns here if not dead key sequ.	/a003
	TAD	(-41)		/ Test for non-printable character	/a003
	SMA	
	ISZ	NXTCHR	/             ITS PRINTABLE SO DO A SKIP RETURN
	TAD	(41	/  RESTORE CHARACTER

	JMP I	NXTCHR	/  RETURN
/--------------
	PAGE

/ LP - PROCESS RECORD

/ THIS CODE WILL INTEGRATE WITH WPSELC.PA TO DO THE MATH ON ALL
/ RECORDS THAT ARE SELECTED AND TO SET UP A NEW RECORD CONSISTING
/ OF THE RESULTS OF ALL FORMULAE AFTER THE LAST RECORD IS PROCESSED.

/ MAJOR ROUTINES/MODULES TO INTEGRATE WITH:
/
/	1) SELCT- ROUTINE IN WPSELC.PA.  GETS NEXT RECORD
/		SELCT WILL CALL THIS ROUTINE JUST
/		BEFORE IT RETURNS TO ITS CALLER
/	2) LFLDNM- ROUTINE IN WPSELC.PA.  GETS FIELD NAME
/		JMS LFLDNM
/		BUFFER_ADDRESS (TOKVAL IN OUR CASE)
/		ON RETURN
/			AC=0	OK
/			AC=-1	END OF RECORD
/			AC=+	ERROR
/				AC=1  '<' BEFORE '>'
/				AC=2  FIELD NAME TOO LARGE
/
/	3) ASCBCD- ROUTINE TO CONVERT A RAW ASCII NUMBER TO PACKED BCD
/		CDFMYF	/ MAKE SURE CDF IS SET TO MY FIELD SO ASCBCD KNOWS
/			/ WHERE TO RETURN
/		CIFMTH	/ CHANGE TO MATH INSTRUCTION FIELD
/		JMS ASCBCD / CALL CROSS-FIELD CALLABLE ROUTINE
/		   ASCII_INPUT_ADDRESS
/		   BCD_OUTPUT_ADDRESS
/		ON RETURN
/			AC=0	OK
/			AC=+    ERROR, NUMBER OF ERROR IN AC
/
/	4) BCDASC- ROUTINE TO CONVERT PACKED BCD TO ASCII USING CORRECT FORMAT
/		CDFMYF	/ MAKE SURE CDF IS SET TO MY FIELD SO BCDASC KNOWS
/			/ WHERE TO RETURN
/		CIFMTH	/ CHANGE TO MATH INSTRUCTION FIELD
/		JMS BCDASC  / CALL CROSS-FIELD CALLABLE ROUTINE
/		   BCD_INPUT_ADDRESS	/ IN MATH FIELD
/		   ASCII_OUTPUT_ADDRESS	/ IN ANY FIELD
/		   CDF TO ASCII_OUTPUT_ADDRESS FIELD
/		ON RETURN
/			AC=POINTER TO FIRST LOCATION AFTER LAST CHAR IN OUTPUT
/
/	5) SYMCHK- ROUTINE IN MATH FIELD TO LOOK UP A SYMBLE IN THE MATH
/			SYMBLE TABLE
/		CDFMYF  / MKE SURE CDF IS SET TO MY FIELD
/		CIFMTH	/ CHANGE TO MATH INSTRUCTION FIELD
/		JMS SYMCHK  / CALL CROSS-FIELD CALLABLE ROUTINE
/		RETURN HERE IF SYMBLE NOT FOUND
/		RETURN HERE IS SYMBLE FOUND   AC=POINTER TO VALUE IN TABLE
/
/
/ ON ENTRY
/	AC=0	NEED TO DO MATH ON RECORD STORED IN EDIT BUFFER AND ADD
/		FIELDS TO RECORD IN EDIT BUFFER FROM RESULTS LIST.
/
/	AC=-1	NO MORE RECORDS. NEED TO CREATE A RECORD IN EDIT BUFFER
/		OUT OF THE RESULTS LISTS.
/
/ ON EXIT
/	RECORD IN EDIT BUFFER CREATED OR MODIFIED AS ABOVE
/	AC UNCHANGED
/
/ PSUEDO-CODE
/
/ PROCESS_RECORD (* CALLED BEFORE SELCT EXITS *)
/
/    IF AC=0  (* A RECORD HAS BEEN SELECTED AND IS IN EDIT BUFFER *)
/	THEN  DO_MATH_ON_CURRENT_RECORD
/	ELSE  CREATE_RECORD_FROM_RESULTS
/
/
/ DO_MATH_ON_CURRENT_RECORD
/
/    INITIALIZE
/    LOOP
/       CALL LFLDNM  (* TO GET NEXT FIELD NAME *)
/		(* ON EXIT: AC=+  ERROR
/			    AC=0  OK
/			    AC=-1 END OF RECORD	*)
/    EXIT IF END OF RECORD
/	SET_UP_TOKVAL (*PUT LENGTH OF FN INTO TOKVAL, ADD 4000 TO LAST CHAR *)
/	CALL SYMCHK  (* LOOKS UP SYMBOL IN TOKVAL IN THE SYMBOL TABLE *)
/	IF FOUND
/	   THEN GET_FIELD_VALUE
/		CALL ASCBCD  (* ASCII TO BCD CONVERSION ROUTINE *)
/	   ELSE READ_PAST_FIELD_VALUE
/    END-LOOP
/
/
/    (* AT THIS POINT WE EITHER HAVE AN END OF RECORD OR AN ERROR *)
/    IF END_OF_RECORD
/	THEN CALL ROUTINE TO EXECUTE THE FORMULAE
/	     INSERT_RESULTS_INTO_EDIT_BUFFER
/	ELSE (* MUST BE AN ERROR *)
/    AC := 0  (* AS IT WAS WHEN WE TOOK CONTROL FORM SELCT *)
/ END DO_MATH_ON_CURRENT_RECORD


/ CREATE_RECORD_FROM_RESULTS
/   INSERT_RESULTS_INTO_EDIT_BUFFER
/   INSERT 0 (* RECORD TERMINATOR *) INTO EDIT BUFFER


/ INSERT_RESULTS_INTO_EDIT_BUFFER
/   INITIALIZE
/   WHILE NOT END OF RESULTS LIST
/	INSERT '<' INTO EDIT BUFFER
/	INSERT FIELD NAME EDIT BUFFER
/	INSERT '>' INTO EDIT BUFFER
/	CALL BCDASC (* TO CONVERT NUMBER TO FORMATTED ASCII *)
/ 	INSERT ASCII NUMBER INTO EDIT BUFFER
/	GET NEXT ENTRY IN RESULTS LIST
/   END-WHILE

/DESCRIPTION OS NAMPTR (USED BELOW)
/NAMPTR, 0	/ POINTS TO AN ENTRY IN THE MATH SYMBLE TABLE.
		/ FORMAT OF SYMBLE TABLE ENTRY IS AS FOLLOWS:

		/	N
		/	A
		/	M
		/	E+4000 (LAST CHAR OF NAME HAS SIGN BIT SET)
		/	FORMAT WORD (INDICATES HOW USER WANTS OUTPUT TO APPEAR)
		/	1ST BCD WORD
		/	2ND BCD WORD
		/ 	3RD BCD WORD
		/	4TH BCD WORD
		/	5TH BCD WORD
		/	6TH BCD WORD

DOMATH,	0
	SNA CLA		/ WERE THERE ANY MORE RECORDS?
	JMP	DMOCR	/   YES, DO MATH ON CURRENT RECORD

/ NO, CREATE RECORD FROM RESULTS
	JMS	INSRST	/ PUT RESULTS IN RECORD BUFFER
	AC7777		/ RESTORE AC TO WHAT IT WAS
	JMP I	DOMATH	/ RETURN TO SELCT (WHO CALLED US)

/ Do_Math_On_Current_Record
DMOCR,	TAD	(RECBUF	/ INITIALIZE POINTERS ETC.
	DCA	RCBPTR	/     INIT AUTO-INCR POINTER TO READ RECORD
			/	TO AFTER FIRST LEFT ANGLE BRACKET
DMNXT,	JMS	LFLDNM	/ LOOP PUT NEXT FIELD NAME INTO GPBUF
	JMP	DMEOR	/ EXIT IF END OF RECORD
	JMS	DMXFER	/     TRANSFER GPBUF TO TOKVAL IN MATH FIELD

			/     CALL SYMBLE TABLE LOOKUP ROUTINE IN MATH FIELD
	CIFMTH		/        CHANGE TO MATH FIELD
	JMS	SYMCHK	/        CALL SYMBLE TABLE LOOKUP ROUTINE
	JMP	NOTFND	/        (RETURNS HERE IF FIELD NOT FOUND)
	DCA	BCDPTR	/     IF FOUND (AC=POINTER TO VALUE)
			/     THEN  SET UP ARGUMENT TO ASBCD
	JMS	LDFLD	/        LOAD FIELD VALUE INTO TOKVAL (IN MATH FIELD)
	JMP	UNDEF	/        IF NOT A NULL FIELD VALUE
	JMS	TOKOUT	/	    THEN OUTPUT TRAILING ZERO AS TERMINATOR
	CIFMTH		/	    CHANGE TO MATH FIELD
	JMS	ASCBCD	/           CONVERT VALUE TO PACKED BCD
	  TOKVAL	/	   	1ST ARG: POINTER TO VALUE (IN MATH FIELD)
BCDPTR,	  0		/ 	   	2ND ARG: POINTS TO DESTINATION OF PACKED
			/ 		    BCD (IN MATH FIELD)
	JMP	ABERR	/ 	    ERROR RETURN, GO HANDLE IT		/M025
	JMP	DMNXT	/ 	
NOTFND,	JMS	GFDEND	/      ELSE (NOT FOUND) SKIP PAST FIELD VALUE
	JMP	DMNXT	/ END-LOOP  (GET NEXT FIELD NAME)

/ ADD OFFSET TO ASCBCD ERROR FOR PROPER REPORTING BY ERROR HANDLER	/A025
ABERR,	TAD	(NSEBE1-NSEBEN)	/ ADD OFFSET TO ERROR NUMBER FROM ASCBCD/A025
	JMP	ERRHAN		/ GO REPORT THE ERROR			/A025

/ COMES HERE ON A NULL FIELD VALUE, SET VALUE IN MATH SYMBLE TABLE TO UNDEFINED
UNDEF,	AC2000		/PUT UNDEFINED BIT IN AC
	CDFMTH	
	DCA I	BCDPTR	/PUT INTO FIRST WORD OF VALUE
	CDFMYF		/
	JMP	DMNXT	/END-LOOP	(GET NEXT FIELD NAME)

/ COME HERE TO HANDLE END OF RECORD. NEED TO CALL ROUTINE TO EXECUTE THE
/ MATH FORMULA THEN ADD RESULTS TO RECORD IN EDIT BUFFER
DMEOR,	CIFMTH		/
	JMS	EXECUT	/  CALL ROUTINE TO EXECUTE MATH FORMULAE
	SZA		/  WERE THERE ANY ERRORS?
	JMP	ERRHAN	/    YES, GO TO ERROR HANDLING ROUTINE
	JMS	INSRST	/    NO, INSERT RESULTS TO RESULT BUFFER
	JMP I	DOMATH	/  RETURN WITH AC=0 TO SELC

/ ROUTINE TO TRANSFER FIELD NAME IN GPBUF TO TOKVAL (IN MATH FIELD)
/ FIRST LOCATION IN TOKVAL NEEDS TO HAVE THE CHARACTER COUNT AND THE
/ LAST CHARCTER IN THE FIELD NAME NEEDS TO HAVE ITS SIGN BIT SET.
DMXFER,	XX
	TAD	(GPBUF-1 / INIT POINTERS AND COUNTER
	DCA	TAI1	 	/INIT POINTER TO SOURCE
	TAD	(TOKVAL-1
	DCA	TAI2	 	/INIT POINTER TO DESTINATION

	TAD	FNCNT		/ FNCNT WAS SET UP BY LFLDNM
	TAD	(-GPBSIZ	/ Take a maximum symbol length of	/a044
	SMA			/ GPBSIZ				/a044
	CLA			/					/a044
	CIA			/ We want to use it as a counter	/a044
	TAD	(-GPBSIZ	/ This gives us a counter no larger than/a044
	DCA	T1		/ GPBSIZ				/m044
	TAD	T1		/ Get it back to store in TOCVAL	/a044
	CIA

/d044	TAD	FNCNT	/ GET COUNT OF CHARACTERS AGAIN

DMLOOP,	JMS	TOKOUT	/ REPEAT; OUTPUT CHARARACTER
	TAD I	TAI1	/ 	GET NEXT CHAR IN FIELD NAME
	ISZ	T1	/ UNTIL LAST CHARACTER
	JMP	DMLOOP	/ 	

DMLAST,	TAD	(4000	/ SET SIGN BIT
	JMS	TOKOUT	/ OUTPUT LAST CHARCTER
	JMP I	DMXFER	/ RETURN

/ OUTPUT A CHAR TO TOKVAL IN MATH FIELD USING TAI2 AS AUTO-INCREMENT REG.
TOKOUT,	XX	
	CDFMTH		/ CHANGE TO MATH FIELD
	DCA I	TAI2	/ OUTPUT CHAR
	CDFMYF		/ CHANGE BACK TO MY DATA FIELD
	JMP I	TOKOUT	/ RETURN


/ INSERT RESULTS INTO RECORD (EDIT) BUFFER

INSRST,	0		
	TAD  (RESBUF	/ INITIALIZE
	DCA  RESPTR	/    INIT AUTO INCREMENT POINTER TO RESULTS
	TAD  (RESULT	/
	DCA  NXTPTR	/    INIT POINTER TO RESULTANT POINTER LIST
INS1,			/ LOOP
	CDFMTH		/    CHANGE DATA FIELD TO MATH FIELD
	TAD I	NXTPTR	/    GET POINTER TO NEXT 'RESULT' FIELD NAME
	CDFMYF		/    CHANGE BACK TO BY FIELD
			/ EXIT IF NO MORE RESULTS
	SNA		/    ARE WE ALL DONE (NO MORE RESULTS)?
	JMP	INSEXT	/    YES, SO EXIT ROUTINE
	DCA	NAMPTR	/    INITIALIZE POINTER TO FIELD NAME
	TAD	("<-200	/    OUTPUT "<" TO RECORD BUFFER
	JMS	RCBOUT	/

/ OUTPUTS FIELD NAME POINTED TO BY NAMPTR TO RECORD BUFFER
NAMOU1,	CDFMTH		/ REPEAT
	TAD I	NAMPTR	/    GET CHARACTER
	CDFMYF
	AND	P177	/
	JMS	RCBOUT	/    OUTPUT THE CHAR
	CDFMTH
	TAD I	NAMPTR	/    GET CHARACTER AGAIN (TO SEE IF LAST ONE)
	CDFMYF		/		(LAST ONE HAS SIGN BIT SET)
	ISZ	NAMPTR	/    INCREMENT POINTER
	SMA CLA		/    WAS IT LAST ONE?
	JMP	NAMOU1	/       NO, DO THE NEXT ONE
			/ UNTIL-SIGN BIT SET (ON LAST CHAR OF NAME)

	TAD	(">-200	/    OUTPUT ">" TO RECORD BUFFER
	JMS	RCBOUT	/

	/ NOW CALL ROUTINE IN IN THIS FIELD TO CONVERT BCD TO ASCII
	JMS	BCDASC	/ CALL BCD TO ASCII ROUTINE WITH THREE PARAMETERS:
NAMPTR,	0	/ POINTS TO AN ENTRY IN THE MATH SYMBLE TABLE.
RESPTR,	0	/ POINTER TO RESULT LIST
	CDFMYF		/ INSTRUCTION FOR BCDASC TO USE TO GET TO
			/ CORRECT DATA FIELD FOR RESULTS

	DCA	RESPTR	/ BCDASC RETURNS WITH POINTER TO END OF ASCII STRING
			/ WHICH BECOMES MY UPDATED POINTER INTO RESBUF
	ISZ	NXTPTR	/    INCREMENT NEXT RESULT POINTER
	JMP	INS1	/ END-LOOP
INSEXT,	TAD	("<-200	/ OUTPUT TRAILING <> FOLLOWED BY A ZERO
	JMS	RCBOUT
	TAD	(">-200
	JMS	RCBOUT
	JMS	RCBOUT	/ OUTPUT TRAILING ZERO
	JMP I	INSRST	/ RETURN

/ OUTPUTS CHARACTER IN AC TO RESULT BUFFER IN THIS FIELD
/ CHECKS FOR OVERFLOW
RCBOUT,	0
	DCA I	RESPTR	/ OUTPUT CHARACTER
	ISZ	RESPTR	/ INCREMENT POINTER
	JMP I	RCBOUT	/

NXTPTR,	0	/ POINTS TO THE NEXT ENTRY IN THE RESULT POINTER LIST. (EACH
		/ ENTRY POINTS TO A NAME IN THE MATH SYMBLE TABLE)
/--------------
	PAGE

/GPBUF has been moved from here to the same area as the other buffers	/a044
/to extend it and make room for multinational and technical characters	/a044
/in field names.							/a044
/
/d044	GPBUF,

*SELINI
				/START OF SELECT PROGRAM
START,	CIFMNU								/M017
	JMS I	OLAYCL		/CALL IN THE EDITOR (MERGE)
	2
	DCA	RECPRO		/ INIT RECORDS PROCESSED		/A025
	DCA	RECNUM		/INIT RECORD COUNTER = 0		/M025
	DCA	SUCREC		/INIT NO. OF MATCHED RECORDS = 0	/M025
	DCA	ERRNUM		/INIT ERROR COUNT = 0			/M025

/ THIS ROUTINE SETS PARAMETERS IN THE SELCT ROUTINE SO THAT A MATH	/A019
/  ERROR WITHIN A CONTROL BLOCK CAN BE REPORTED PREVIOUS TO THE READING	/A019
/   OF THE FIRST RECORD OF THE LIST.  AFTER THE FIRST RECORD IS READ	/A019
/    THESE PARAMETERS ARE CHANGED BY SELCT ROUTINE AS NORMAL.		/A019
	TAD	(5600)		/ GET INSTRUCTION JMP I, CURRENT PAGE,	/A019
				/  ADDRESS ZERO				/A019
	DCA	SELCTX		/ INSTALL IN SELCTX			/A019
	TAD	(ERRXIT)	/ GET THE ADDRESS OF ERROR HANDLER	/A019
	DCA	SELCT		/ INSTALL IN SELCT			/A019

/CALL MADE FROM HERE TO MATH FIELD TO INITIALIZE MATH DATA STRUCTURES	/A018
/FLAGS, ETC., USED IN PROCESSING OF MATH CONTROL BLOCKS.		/A018
/NOTE - THIS CALL NOW SET UP TO ALSO SET "TYPMTH" FLAG IN MATH FIELD	/A031
/       THE VALUE TO SET THE FLAG IS PASSED TO "RTRN4" VIA THE AC	/A031
/       IN THIS CASE THE FLAG IS SET TO ZERO TO INDICATE THAT LP MATH	/A031
/	IS BEING USED. SINCE THE AC IS ZERO COMING INTO THE CALL NO	/A031
/	FURTHER CODE ENHANCEMENTS ARE NECESSARY				/A031

	CIFMTH			/CHANGE PROGRAM CONTROL TO MATH FIELD	/A018
	JMS RTRN4		/GO INITIALIZE MATH MODULE VALUES	/A018

	CDFBUF		/STORED IN BUFFER FIELD
	AC0001			/GET FROM RECORD NUMBER
	TAD I	(SPCADR)
	DCA	T1

/	THE FROM RECORD COUNT RANGES FROM 1 TO 4095.  A FROM COUNT OF	/A042
/	ZERO MEANS START AT THE FIRST RECORD.  IN ORDER TO FACILATE THE /A042
/	COUNTING OF RECORDS AND THE RANGE CHECKS, THE FROM COUNT HAS 	/A042
/	SHIFTED DOWN BY ONE UNIT TO ALLOW FOR THE MAXIMUN OF 4095.	/A042

	TAD I	T1		/PICK UP THE FROM RECORD COUNT
	CDFMYF
	SZA			/OK IF ZERO START RECORD		/A042
	TAD	(-1		/DECREMENT THE COUNT			/A042
/D042	CIA			/NEGATE
	DCA	FRREC		/AND  STORE IT AWAY
	ISZ	T1		/GET TO RECORD NUMBER
	CDFBUF
	TAD I	T1
	CDFMYF
/D042	CIA			/NEGATE
	DCA	TOREC		/AND STORE
	CDFBUF
	TAD I	(OTFIL)		/GET OUTPUT FILE NUMBER
	DCA	OUTFIL		/AND SAVE IT
	TAD I	(LSTFIL)	/GET LIST FILE NAME
	CDFMYF			/BACK TO MY FIELD
	JMS	RDINIT		/OPEN FILE

	TAD	FRREC		/PICK UP THE FIRST RECORD TO PROCESS	/A042
	IAC			/PUT BACK INTO CORRECT FORMAT		/A042
	JMS	SEARCH		/DISPLAY MESSAGE - SEARCHING FOR RECORD	/A042

TITLP,	CDFSYS			/SEE IF HALT FLAG ON ?
	TAD I	HLTFLG
	CDFMYF
	SZA CLA
	JMP	FINUP		/YES, FINISH UP
	JMS	GETCHR		/NO, GET A CHAR
	JMP	FINUP		/EOF RETURN, FINISH UP
	AND	P177		/LOSE CONTROL
	TAD	(-74		/SEE IF '<'
	SZA CLA
	JMP	TITLP		/NO, KEEP LOOKING
	JMS	SELCT		/GET FIRST MATCHED RECORD		/M017
	SZA CLA
	JMP	FINUP		/NO RECORDS SO TELL USER
	TAD	OUTFIL		/OTHERWISE, SEE IF TO PRINTER
	SNA CLA
	JMS	PRNQUE		/YES, QUEUE IT
	CIFEDT			/CHANGE TO EDITOR FIELD			/A017
	JMS I	(MERGE)		/AND CALL MERGE PROGRAM
	SZA CLA			/EDITOR RETURNS NON-ZERO IF DISK IS FULL/A0011
	JMP	DSKFUL							/A0011

FINUP,	JMP	ERRXIT		/YES, GIVE MESSAGE

DSKFUL,	TAD	(EVFULL)	/ ERROR - DISK FULL		   /A0011/M025
	DCA	ERRNUM							/A0011
	JMP	ERRXIT		/GIVE MESSAGE				/A0011

OUTFIL,	0

SINFLG,	XX		/THIS ROUTINE INITS THE SUCCESS FLAGS TO FALSE	/M025

	AC4000			/INIT THE MQ WITH A FALSE AND SET
	MQL			/TO TRUE ON MATCH FLAG
	TAD	(SPECTB		/GET 1ST LOC OF SPECIFICATION TABLE
	DCA	SPCSCN		/SAVE AS PTR
	TAD I	SPCSCN		/GET TYPE WORD
INFGLP,	SNA
	JMP I	SINFLG		/0 TYPE, ALL DONE
	AND	P177		/GET RID OF OLD FLAGS
	TAD	(-3		/SEE IF IT'S A 3 (BUT NOT)
	SNA
	JMP	INBNI		/YES, NEEDS DIFFERENT FLAGS
	TAD	(3		/NO, GET TYPE BACK
	MQA			/OR IN FLAGS
INFGL1,	DCA I	SPCSCN		/STORE IT BACK
	JMS	GTYPE		/GET NEXT TYPE WORD
	JMP	INFGLP		/GO SET IT

INBNI,	TAD	(2003)		/INIT TO TRUE AND SET TO FALSE ON MATCH FLAGS
	JMP	INFGL1		/STORE IT

SPCSCN,	0

GTYPE,	XX		/GETS THE NEXT TYPE WORD AND RETURNS IT IN THE	/M025
			/AC USING SPCSCN AS A PTR.			/M025

	CLA
	ISZ	SPCSCN		/ADD TWO TO PTR.
	ISZ	SPCSCN
	TAD I	SPCSCN		/TO GET OR-COUNT
	CLL RTL			/ * 4
	IAC			/PLUS 1 TO MOVE ALONG
	TAD	SPCSCN		/ADD IN ADDR.
	DCA	SPCSCN		/SHOULD GET NEXT TYPE WORD
	TAD I	SPCSCN
	JMP I	GTYPE		/RETURN

SRCH,	0		/JUST DOES AN EXACT COMPARE
	JMS	XSCMP
SPCSTR,	0
RECSTR,	0
	CDFBUF
	JMP I	SRCH
/--------------
	PAGE

GFDEND,	XX		/READS UNTIL THE END OF THE CURRENT FIELD	/M025
			/USING RCBPTR AND RETURNS A PTR TO THE LAST
			/LOC. IN THE FIELD IN FDEND, EXCLUDING THE LAST CHAR
			/LESS THAN 41 IF ONE IS PRESENT.
			/CALLED BY:
			/JMS	GFDEND
			/  EXIT IF ERROR
			/REGULAR RETURN (AC 0)

GFDLP,	JMS	SSRBRD		/GET A CHAR
	TAD	(-74		/SEE IF '<' ?
	SNA
	JMP	GFDDN		/YES, END OF FIELD
	TAD	(-2		/NO, SEE IF '>' ?
	SZA CLA
	JMP	GFDLP		/NO, KEEP LOOKING
	JMP	REVRBFD		/ ERROR - '>' FOUND IN FIELD		/M025

GFDDN,	AC7777			/GET LAST CHAR IN FIELD
	TAD	RCBPTR
	DCA	T1
	CDFBUF
	TAD I	T1
	CDFMYF
	AND	P177		/WITHOUT CONTROLS
	TAD	(-15		/If last char is End Dead, do not ignore/a044
	SZA			/Is it End Dead?			/a044
	TAD	(15-41		/NO, SEE IF LESS THAN 41		/a044
	SPA CLA
	AC7777			/YES, DON'T TRY TO MATCH LAST CHAR
	TAD	T1		/STORE PTR TO LAST CHAR TO MATCH
	DCA	FDEND
	JMP I	GFDEND		/RETURN

ENUM,	TAD	MLEN
	SMA CLA			/SEE IF EXACT NUMERIC COMPARE ?
	JMP	MNUM		/NO
	TAD	ELEN		/YES, CHECK LENGTH
	CIA
	TAD	NUMSIZ
	SZA	 CLA		/EQUAL ?
	JMP	ORLP		/NO, FAIL
	JMS	NUMCMP		/YES, DO CHAR BY CHAR COMPARE
	SNA CLA			/EQUAL ?
	JMP	TRUE		/YES, SET MATCHED FLAG
	JMP	ORLP		/NO, FAIL AND TRY NEXT OR-GROUP

MNUM,	TAD	ELEN		/NUMBER OR MORE COMPARE ?
	SNA
	JMP	LNUM		/NO
	CIA			/YES, CHECK LENGTH
	TAD	NUMSIZ
	SPA			/LARGER
	JMP	ORLP		/NO, FAIL
	SZA CLA			/YES, SEE IF SAME SIZE ?
	JMP	TNUM		/NO, SEE IF THRU COMPARE
	JMS	NUMCMP		/YES, DO CHAR BY CHAR COMPARE
	SPA CLA			/CHECK IF GREATER THAN OR EQUAL TO ?
	JMP	ORLP		/NO, GET NEXT OR-GROUP

TNUM,	TAD	MLEN		/YES, NUMBER THRU NUMBER COMPARE ?
	SNA CLA
	JMP	TRUE		/NO, SET MATCH FOUND FLAG
	TAD	ELEN		/YES, MOVE SPEC STRG PTR TO NEXT NUMBER
	TAD	SPCSTR
	DCA	SPCSTR

LNUM,	TAD	MLEN		/CHECK IF SMALLER ?
	CIA
	TAD NUMSIZ
	SMA SZA
	JMP	ORLP		/NO, FAIL IMMEDIATELY
	SZA CLA			/YES, SEE IF SAME SIZE
	JMP	TRUE		/NO, SET MATCH FOUND FLAG
	JMS	NUMCMP		/YES, DO CHAR BY CHAR COMPARE
	SMA SZA CLA		/CHECK IF LESS THAN OR EQUAL TO ?
	JMP	ORLP		/NO, GET NEXT OR-GROUP
	JMP	TRUE		/YES, SET MATCH FOUND FLAG

PRNQUE,	0	/QUEUES THE FORM FILE TO THE PRINTER			/M029
	CDFMNU								/M029
	TAD I	(PQADDR)	/GET PRINT QUEUE ADDRESS 		/M029
	CDFMYF			/   IN COMMAND FIELD			/M029
	DCA	T2		/STORE TO INDIRECT THROUGH		/M029

	CDFPRT								/M029
	AC0001								/M029
	DCA I	(PRIRFD)	/SET FLAG IN PRINT FIELD TO SAY WE ARE DOING
				/LIST PROCESSING			/M029
	CDFBUF			/					/M029
	TAD I	(FORMNO)	/GET FORM FILE NUMBER IN BUFFER FIELD	/M029
	CDFMNU			/					/M029
	DCA I	T2		/PUT AS FIRST ENTRY IN PRINT QUEUE	/M029
	ISZ	T2		/NOW POINT TO NEXT LOCATION AND		/M029
	DCA I	T2		/ STORE A TERMINATING ZERO IN THE QUEUE	/M029

	TAD I	(PQADDR)						/M029
	DCA I	(PQFRST)	/SET UP PRINT QUEUE FIRST AND LAST POINTERS
	TAD I	(PQADDR)	/TO POINT TO SAME PLACE TO INDICATE ONLY
	DCA I	(PQLAST)	/ONE ENTRY IN THE PRINT QUEUE		/M029
	CDFMYF								/M029
/D041	TAD	(PRJOB)		/GET ADDRESS OF PRINTER STATUS BLOCK	/M029
/D041	CIFSYS;	JSTRT		/START UP PRINTER JOB			/M029
	JMP I	PRNQUE		/RETURN					/M029


/ CLEAR SCREEN, HOME CURSOR AND OUTPUT SEARCH FOR RECORD MESSAGE	/A042
SEARCH,	XX								/A042
	DCA	SRCREC		/SAVE RECORD NUMBER TO BE SEARCH FOR	/A042
	CIFMNU			/SET TO MENU FIELD			/A042
	JMS I	IOACAL		/CALL IOA TO DISPLAY A MESSAGE		/A042
	0			/USED FOR DEFAULT OUTPUT ROUTINE	/A042
	SRCMSG			/ MESSAGE ADDRESS			/A042
	0000			/ ^P - POSITION CURSOR HOME		/A042
				/ ^E - ERASE SCREEN			/A042
SRCREC,	0			/ ^D - RECORD NUMBER			/A042
	JMP I	SEARCH		/ RETURN TO CALLER			/A042

SRCMSG,	IFDEF ENGLSH <TEXT '^P^E&SEARCHING FOR RECORD: ^D'>		/A042
	IFDEF ITALIAN<TEXT '^P^E&RICERCA DEL RECORD: ^D' >
/--------------
	PAGE

	/THIS IS WHERE THE TABLES, ETC. GO

	FIELD 3
	*SELINI

/ IT IS THROUGH THIS OVERLAY THAT WE CAN EITHER REPORT AN ERROR		/A025
/  CONDITION AND OR PLACE THE RESULT DATA OF THE LIST PROCESSING	/A025
/   OPERATION								/A025
/
REPORT,
/ DELETED CODE TO CHECK PRLOCK--DECMATE IS A SINGLE USER SYSTEM		/A043

/ DELETED CODE TO CLEAR PRSTTS.  LEAVE IT IN CASE HAVE ERROR		/A041
/ WHILE PRINTER'S BUFFER IS EMPTYING					/A041

/ WE NO LONGER NEED TO START THE PRINTER JOB SINCE IT ALWAYS RUNS	/A041

	CDFMYF
	TAD	RECNUM							/M025
	DCA	T1		/ HOLD UPDATED RECORD NUMBER IN T1	/M025

	TAD	RECPRO		/ GET # OF RECORD PROCESSED		/A025
	DCA	T2		/ HOLD NO. OF RECORDS PROCESSED		/M025

	TAD	ERRNUM		/ GET ERROR NUMBER.  IF ERRNUM = 0 THEN	/A025
				/ THERE WAS NO ERROR SO WE'LL JUST	/A025
				/  PRINT THE RECORD SUMMARY.		/A025
REPOR2,	DCA	T3		/ HOLD IT IN T3				/M035


/ REPOR2 WILL SET UP THE LOCATIONS IN MNUFLD AS FOLLOWS:		/A025
/	MNTMP1 = 0, MEANING "LIST PROCESSING ERRORS"			/A035
/ 	MNTMP2 = NO. OF RECORDS PROCESSED				/A025
/ 	MNTMP3 = NO. OF RECORDS SELECTED				/A025
/ 	MNTMP4 = CURRENT RECORD COUNT					/A025
/ 	MNTMP5 = ERROR OR CONTROL NUMBER				/A025

	TAD	SUCREC		/ GET NUMBER OF RECORDS SELECTED	/M035
	CDFMNU								/A025
	DCA I	(MUBUF+MNTMP3)	/ STORE IT IN MENU FIELD		/A025
	TAD	T1		/ CURRENT RECORD COUNT			/A025
	DCA I	(MUBUF+MNTMP4)	/ STORE IT IN MENU FIELD		/A025
	TAD	T2		/ NUMBER OF RECORDS PROCESSED		/A025
	DCA I	(MUBUF+MNTMP2)	/ STORE IT IN MENU FIELD		/A025
	TAD	T3		/ GET ERROR NUMBER (OR CONTROL VALUE)	/A025
	DCA I	(MUBUF+MNTMP5)	/ STORE IT IN MENU FIELD		/A025
	DCA I	(MUBUF+MNTMP1)	/ SET FLAG TO INDICATE LIST PROCESSING	/A035
	CDFMYF								/A025
	CIFMNU								/A025
	JMS I	MNUCAL		/ REPORT VIA MENU			/A025
	DLMLP5								/A025

	CDFMNU			/ HAVE WE RETURNED HERE TO PRINT MATH	/A025
				/  CONTROL BLOCK ERROR?			/A025
	TAD I	(MUBUF+MNTMP5)	/ MNTMP5 IS EITHER SET OR UNCHANGED IN	/A025
				/  MENU DEPENDING ON THE ERROR NUMBER.	/A025
				/   IF MNTMP5 = 0 THEN EXIT ELSE PRINT	/A025
				/    MATH CONTROL BLOCK LINE THAT 	/A025
				/     CONTAINS THE ERROR THEN RETURN TO	/A025
				/       MENU TO PRINT RECORDS SELECTED	/A025
				/	 AND PROCESSED.			/A025
	CDFMYF								/A025
	SNA CLA			/ SKIP IF: NEED TO PRINT ERROR LINE	/A025
	JMP	LEAVLP		/ WE'RE DONE.  EXIT LIST PROCESSING	/A025

	TAD	(600		/ TELL PELINE TO PRINT ON LINE 7	/A035
	CIFMTH			/ CHANGE INSTRUCTION FIELD TO MATH FIELD/A025
	JMS	PELINE		/ PRINT LINE IN CONTROL BLOCK THAT	/A025
				/  CONTAINS THE ERROR AND POINT TO	/A025
				/   ERROR				/A025

	AC0001			/ CONTINUE FROM PRINTING ERROR MESSAGE	/A025
	JMP	REPOR2		/ SET CONTROL = CONTINUE FROM PRINTING	/A025
				/  ERROR MESSAGE			/A025

/ TO EXIT WE MUST RETURN TO THE ROUTINE WHICH CALLED WPPARSE. THE	/A017
/ ADDRESS IS IN THE BUFFER FIELD (PUT THERE BY WPPARS) BUT THE ROUTINE	/A017
/ IS IN THE MENU FIELD							/A017

LEAVLP,	CDFBUF			/ CHANGE TO BUFFER FIELD		/M025
	TAD I	(RETADR		/ GET RETURN ADDRESS (OF ROUTINE WHICH	/A017
				/   ORIGINALLY CALLED WPPARS)		/A017
	DCA	T3		/ PUT INTO PLACE			/M025
	CDIMNU			/ CHANGE TO MENU FIELD			/A017
	JMP I	T3		/ AND RETURN				/M025

	FIELD	2
	*RDFIL

/THIS IS WHERE RDFILP GOES