Google
 

Trailing-Edge - PDP-10 Archives - BB-5372D-BM - traffic/source/tfrcob.mac
There are 2 other files named tfrcob.mac in the archive. Click here to see a list.
;COPYRIGHT (C) 1980 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.

	TITLE	TFRCOB - COBOL ROUTINES FOR TFR


;***COPYRIGHT (C) 1976,1977,1978,1979,1980,1981 DIGITAL EQUIPMENT CORP.,
;	MAYNARD MASS.***


IF1	<PRINTX TFRCOB-20 VERSION 2A(126)>

COMMENT	^ EDIT HISTORY

EDIT	DESCRIPTION
-------------------

2	CHARACTERS SOMETIMES ARE LOST WHEN AN ERROR MSG IS
	DISPLAYED AND AN IGNORABLE CHARACTER IS TYPED.
	(SEE EDIT 2 IN TFRTRM)

3	CORRECT SPELLING IN ERROR MESSAGE (ENTERRED => ENTERED).

4	CORRECT PREVIOUS DUPE FIELDS FROM MESSING UP MONEY, DATE,
	AND SOC-SEC-NUMBER FIELDS.

5	MAKE OPTIONAL DATE FIELDS REALLY OPTIONAL; I.E.,
	TABBING PAST FIELD AND NOT TYPING ANYTHING IS
	ALLOWED AND DOES NOT GIVE 'INVALID DATE' MESSAGE.

6	RELEASE OLD JFN WHEN CHANGING DATA FILES; OTHERWISE,
	PROGRAM CAN RUN OUT OF JFN'S.

7	ALLOW CHECKING OF NUMBER OF ARGUMENTS USED IN
	COBOL CALL TO TFR ROUTIES; 
	HALT IF ERROR OCCURS.
	THIS FEATURE IS INCLUDED IF FTARGS IS SET TO 1.

10	MAKE THE FORM DEFINED VALUES IN NUMERIC PROTECTED VARIABLES
	DISPLAY RIGHT JUSTIFIED.

11	WHEN UNPROTECTED VARIABLES WITH VALUE CLAUSES IN FORM FILE ARE
	INITIALIZED, ONLY PART OF THE FIELD IS FILLED WITH FILLERS.
	FIX THIS PROBLEM.

12	CHANGING RANGE VALUES DOES NOT ALWAYS WORK.
	  SETTING MONEY FIELDS FROM NUMERIC VARIABLES WITH IMPLIED
	  DECIMAL PLACES  (99V99) DOES NOT WORK.

13	CHANGING CLASS FROM NUMERIC OR ALPHA ONLY TO ALPHANUMERIC
	DOES NOT WORK.  FIX IT.

14	WHEN PROGRAM IS READING BY SECTIONS OR FORMS AND USER TYPES
	AN 'ABORT NOW CHARACTER (LIKE LINE FEED)', TRAFFIC TYPES OUT
	0'S FOR NUMERIC FIELDS IN THE REMAINDER OF THE SECTION. THIS
	IS MOST OFTEN FOLLOWED BY RESETTING THEM BACK TO FILLERS WITH
	THE NEXT INIT. --A VERY COSTLY THING TO DO ON MANY FORMS.
	FIX--DO NOT DO THIS.

15	TRAFFIC HAS HIGH OVERHEAD -- MAKE CHANGES SO THAT READING OF
	CHARACTERS FROM THE TERMINAL USES LESS CPU TIME.
		A.  ELIMINATES THE NEED FOR THE TYPE-IN INTERRUPT
		B.  USES LOCAL CODE IN PLACE OF THE TEXTI JSYS
		C.  ALSO MAKES CHANGES IN TFRTRM.MAC (EDIT [??])


16	CHECK FORMAT AND RANGE OF DATES CORRECTLY.


17	TFRCLR WILL STOP ON FIRST NONE DISPLAY FIELD IN A SECTION AND
	RETURN AN ERROR CODE.  THE FIX IS TO STILL RETURN THE ERROR
	CODE IF ANY FIELD IN THE SECTION IS NOT CURRENTLY DISPLAY, BUT
	TO CLEAR ALL THAT ARE DISPLAYED. ALSO MAKE OTHER OPERATIONS
	WHICH ENCOUNTER CLEARED FIELDS CONTINUE TO WORK.

20	VALIDITY CHECKS ON PREVIOUS DUPE DATE FIELDS AND Y/N FIELDS
	DOES NOT WORK BECAUSE THE <TAB> IS STORED IN THE FIELD.

21	FIX PROBLEMS WITH MINUS SIGNS AND SURPRESS LEADING ZEROS
	ON DISPLAYS OF NUMERIC FIELDS.

22	CHANGED ATTRIBUTES BECOME PERMINENT AND DO NOT GO AWAY AS THEY
	ARE SUPPOSED TO AT INITIALIZATION TIME. ..PROBLEM IS THAT THERE
	ARE NOT ENOUGH BITS --- FIX THIS.

23	IF A SECTION (OR FORM) IS INITIALIZED AND THEN A FIELD (OR MORE)
	IS CLEARED, READING BY SECTION WILL FAIL WHEN THE FIRST CLEARED
	FIELD IS ENCOUNTERED -- SHOULD MERELY BE BYPASSED.


24	FIX THE ESCAPE SEQUENCES WHICH REINIT THE FIELD, THE READ
	AND REWRITE THE SCREEN SO THAT THEY WORK WITH PREVIOUS DUPE.

25	MAKE LF, AND OTHER TERMINATOR FUNCTION THE SAME AS TAB
	ON PREVIOUS DUPE FIELDS.

26	FIELDS WITH THE FULL ATTRIBUTE IMPROPERLY PLACE THE CURSOR
	AFTER A LINE FEED TO TERMINATE.

27	THE FULL ATTRIBUTE COMBINED WITH OTHERS PRODUCES WRONG RESULTS.
	IT SHOULD:
		1. ALLOW PREVIOUS DUPE TO WORK.
		2. BYPASS IF FIELD OPTIONAL AND NO CHARS TYPED.

30	EX. IN A NUMERIC FIELD, TYPE AN 'A'. THIS WILL GENERATE
	AND ERROR MESSAGE AND WILL MOVE THE CURSOR TO THE POSITION
	OF THE 'A' AND OVERWRITE IT WITH THE FILLER. A SUBSEQUENT
	BACKSPACE WILL BACKUP THE LOGICAL INFORMATION BUT NOT
	THE CURSOR. SUBSEQUENT BACKSPACES WILL WORK. THIS APPEARS
	TO BE A PROBLEM WITH THE TERMINAL. THE SOLUTION IS TO
	SEND AN EXTRA BACKSPACE AFTER ERASING THE ERROR MESSAGE.

31	CHANGING RANGES DOES NOT WORK. MAKE IT WORK.
	LOW VALUES WILL TURN OF RANGE BUT NOT DESTROY VALUE.
	INIT WILL TURN ON RANGE. USER NEEDS TO SPECIFIY LOW
	VALUES FOR THE RANGE TO TURN OFF (UPPER OR LOWER).

32	RANGE CHECKING, ESPECIALLY WITH NEGATIVE NUMBERS DOES
	NOT WORK, MAKE IT.

33	AFTER A GROUP READ WHICH ENDS WITH A NUMERIC FIELD IS
	TERMINATED WITH A LF OR SOMETHING OTHER THAN A TAB OR
	FULL FIELD, THIS LAST FIELD IS NOT JUSTIFIED--DO IT.

34	IF NO CHARACTERS ARE TYPED IN A FIELD, AND IT IS OPTIONAL,
	THEN DO NOT DO RANGE CHECKING.

35	ADD CODE TO MAKE THIS WORK WITH VERSION 12 OF COBOL
	WHICH REDEFINES THE FREE AREA.

36	INTEGRATE WITH TFRTRM.V52 SINCE THIS VERSION WILL NEVER
	SUPPORT TERMINALS OTHER THAN VT52'S.

37	THE REWORKING OF THE CODE HAS FIXED MANY BUGS WHICH MAY
	ACTUALLY BEING USED AS FEATURES.  THE PREDOMINENT ONE IS
	THAT MANY ATTRIBUTES MAKE A FIELD REQUIRED (YES/NO, RANGES,
	ETC.) IF USER IS UTILIZING THIS FEATURE, THEN ALLOW IT
	TO WORK.

40	THE CODE IS DIFFICULT TO WORK ON AND READ, REMOVE SOME OF
	THE MORE OBSCURE HIPO CONSTRUCTS AND REPLACE WITH A
	MORE STRUCTURED LOOKING CODE.

41	OPTIMIZE THE SCREEN INITIALIZATION CODE.

42	DURING INITIALIZATION OF A FIELD, SET ALPHAS AND ALPHANUMERICS
	TO SPACES (AS DONE CURRENTLY) AND NUMERICS TO ZEROS (CURRENTLY
	SPACES) AND THEN OPTIMIZE FIELD READING CODE.

43	ADD 2 NEW CALLS TO RESTORE TERMINAL TO KNOWN STATE AFTER
	MAKING CALLS TO LOWER FORK OR AFTER USING THE COBOL
	'DISPLAY' STATEMENT.  THE CALLS DO NOT HAVE ANY ARGUMENT
	AND ARE:
		TFRSET -- TO SET TERMINAL CHARACTERISTICS FOR TRAFFIC
		TFRRST -- TO SET TERMINAL CHARACTERISTICS FOR USER MODE
		TFRRWT  -- TO REWRITE THE SCREEN (LIKE THE BLACK BUTTON).

	AFTER USING A LOWER FORK, BOTH ROUTINES SHOULD BE CALLED.
	AFTER USING THE DISPLAY VERB, AT LEAST TFRSET SHOULD BE CALLED.
	ALSO MAKE RESETTING OF THE TERMINAL TO A KNOWN STATE AUTOMATIC
	ON EACH CALL WITH PARAMETER  OLD%TT=1.  IF USER UTILIZES THE
	NEW ROUTINES, THEN SETTING THIS TO OLD%TT=0 WILL INCREASE THE
	EFFICIENCY OF TRAFFIC.

44	ADD NEW ROUTINE  'TFRFNO' USING THE CALL SEQUENCE:

	   ENTER MACRO TFRFNO USING FIELD-NAME, FIELD-NUMBER,ERROR.

	THE FUNCTION OF THIS ROUTINE IS TO RETURN TO THE USER A
	FIELD NUMBER BASED ON THE ASCII OR SIXBIT FIELD NAME SUPPLIED.
	IF THE FIELD NAME IS NOT IN THE CURRENTLY INITIALIZED FORM, THEN
	AN ERROR WILL BE RETURNED.  SINCE SEARCHING FOR FIELD NAMES
	IS EXPENSIVE, GENERATING FIELD NUMBERS IN THIS MANNER CAN GAIN
	EFFICIENCY.

45	WHEN A MASTER DUPE FIELD IS WRITTEN (TFRWRT) OR WHEN IT
	IS CREATED WITH TFRCHG, TURN ON THE 'MASTER DUP SET' FLAG
	IF IT REALLY HAS DATA IN IT.

46	MONEY FIELDS WITH NO DOLLAR DIGITS DO NOT GET BLANK FILLED
	CORRECTLY AND OVERWRITE DECIMAL POINT ON READ IF PREV-DUPE.

47	HAVING INSUFFICIENT NUMBER OF DATA PAGES RETURNS BAD ERROR
	INDICATOR. FIX THIS.

50	ADD NEW ATTRIBUTE TO FIELD DESCRIPTION TO ALLOW FOR ZERO FILLED
	NUMERICS (ACCOUNT NUMBERS, ETC.) USER MAY INCLUDE
		LEADING-ZEROS
	 OR
		NO-LEADING-ZEROS
	TO A NUMERIC FIELD DESCRIPTION.

51	ON LOW BAUD RATE SYSTEMS, REWRITING NUMERICS RIGHT JUSTIFIED
	IS NOT ALWAYS WANTED. INCLUDE A SWITCH TO DISABLE THIS FEATURE.

52	MAKE THE MEMORY GETTING/FREEING DYNAMIC AND VOID THE NECESSITY
	OF SETTING DAT%SZ AND SYM%SZ.

53	MAKE IT POSSIBLE TO CHANGE SPECIFIC SYSTEM VARIABLES FROM THE
	USER PROGRAM TO AVOID REASSEMBLY OF TFRCOB, SPECIFICALLY:

		VAR# 1,OLDTT -- -1 IF SETTING TERMINAL CHARACTERISTICS ON
					EACH CALL,
			     --  0 IF SETTING ON DEMAND (FOR EFFICIENCY).

		VAR# 2,OLDRN --  0 REWRITE NUMERIC VALUES RIGHT JUSTIFIED.
			     -- -1 DO NOT REWRITE NUMERIC VALUES.

54	COMPENSATE FOR PROBLEM WITH V12 MEMORY MANAGEMENT WHICH MAY
	GET FIXED. WHEN IT DOES, STATEMENTS WITH ;[54] MAY BE
	REMOVED (EXCEPT THE ONE SO MARKED).
	ALSO DEFINE NEW SWITCH COB%VR=0 FOR V12,=-1 FOR V11, =1
	FOR UNDECIDED.

55	FIX PROBLEM WITH USING COBOL ACCEPTS (THEY DO NOT ECHO).

56	TFRERR ASSUMES MESSAGE (FIRST ARG) IS WORD ALIGNED. DUMB.
	ALSO PRINT THE MESSAGE EVEN IF THE FIELD CANNOT BE RESET.

57	ADD ATTRIBUTE TO ALPHABETIC FIELD WHICH MAKES SPACES LEGAL.
	OLD DOCUMENTATION INDICATED SHOULD BE SO, BUT WAS NOT.

60	ALLOW USER TO WRITE TO FIELDS WHICH ARE NOT INITIALIZED USING
	TFRWRT.  THIS ALLOWS A USER TO BACKUP ON A MULTIPART FORM
	IN ORDER TO CHANGE INFORMATION.  IT WILL STILL RETURN AN
	ERROR INDICATOR (4) IF AN UNINITIALIZED FIELD IS FOUND, BUT IT
	SHOULD BE TAKEN AS A WARNING. PUT THIS UNDER ASSEMBLY SWITCH
	OLD%WR.

61	ALLOW LIMITED LOWER CASE. ALLOW TFRCOB TO BE ASSEMBLED WITH
	LOWERCASE ALLOWED. THE LIMITATION IS THAT YES-NO FIELDS WILL
	REQUIRE UPPER CASE, DATE FIELDS WILL REQUIRE UPPER CASE MONTHS,
	AND RANGE CHECKING WILL BE IN COLLATING SEQUENCE ORDER. THIS
	IMPLIES THAT WITH AN UPPER RANGE OF "ddddddd" (THAT WAS lowercase
	FOR LISTINGS THAT ARE UPPER CASE ONLY) WILL PERMIT AN ENTRY
	OF "ZZZZZZZ" (UPPER CASE) SINCE LOWER CASE IS A HIGHER
	COLLATING SEQUENCE THAN UPPER CASE. THE USER WILL BE ABLE
	TO DISABLE/ENABLE THIS VIA CALLS TO TFRSYS.

62	MAKE IT POSSIBLE TO TURN OFF THE INTERRUPT SYSTEM DURING
	COBOL ACCEPT STATEMENTS SO THAT RUBOUT, AND CONTROL CHARACTERS
	WORK.   ADD CALL  TFRRST (TFR-RESET)

63	ALL 'CALL TFRXXX USING' TO WORK AS WELL AS 'ENTER MACRO TFRXXX'.

64	STRUCTURE TERMINAL OUTPUT FOR BETTER EFFICIENCY LATER.

65	ERRORS WHEN SIXBIT FORM-NAMES ARE USED OF VARYING LENGTHS
	AND IN CONJUNCTION WITH TFRERR MESSAGES.  PROBLEM IS THAT
	'INTBUF' GETS USED FOR BOTH AND IS NOT CLEARED.

66	TFR ALLUDES TO FACT THAT VALUE MAY CONTAIN MORE CHARACTERS
	THAN ARE IN FIELD. THIS CAN LEAD TO COMPLICATIONS LATTER.
	TFR SHOULD BE FIXED, BUT FIELD SHOULD ALSO BE CHECKED.

67	PUT IN SECTION AND FIELD TABLES WHICH BOUND THE SEARCH
	OF THE FIELD TABLE TO A SUBSET OF IT AND THUSLY BOOST PERFORMANCE
	ESPECIALLY WITH FORM WITH A LARGE NUMBER OF FIELDS.

70	CAUSE THE TFRERR MESSAGES TO BE TRUNCATED AFTER TRAILING
	BLANKS LIKE COBOL DISPLAYS.

71	MAKE IT POSSIBLE FOR OPERATORS TO BACK UP FIELDS.

72	ALLOW CONTROL/C TRAPPING IF THE USER SPECIFIES IT
	BY SETTING OLD%CC=-1 EITHER DURING ASSEMBLY OF VIA
	A CALL TO TFRSYS.
 73	FIX A COUPLE BUGS WITH EDIT 67 WHERE ILLEGAL FIELD NAMES
	AND SECTION NUMBER CAN CAUSE UNTOWARD RESULTS (SOMETIMES).

74	TFR.MAC -- CHANGE TO MAKE IT ACCEPT EDIT FILES WITH PAGE
	BREAKS IN THEM.

75	INCLUDE A TABLE OF FIELD NUMBERS IN THE FILE WITH THE RECORD
	DESCRIPTION

76	ADD THE FIELD NUMBER TO THE SUMMARY FILE.

77	IF RUNNING UNDER VERSION 12 OF COBOL, THEN PUT CODE
	OF TFRCOB INTO 'HIGH' SEGMENT

100	SOME ERRORS OCCURING IN THE RIGHT MOST COLUMN (80 ON VT52)
	CAUSE THE CURSOR TO BE IMPROPERLY PLACED AFTER THE ERROR
	MESSAGE.

101	IF NO FORM HAS BEEN INITIALIZED (OR AN ERROR WAS IGNORED),
	MAKE THE FIND ROUTINE INFORM THE CALL OF 'NO FIELD' CONDITION.

102	ADD THE CANADIAN DATE   DD/MM/YY

103	TFR PROBLEM -- TRAFFIC ERROR MESSAGES SOMETIMES MASK PROBLEMS
		WHICH WOULD HAVE BEEN DETECTED IF SYSTEM (JSYS) ERROR
		MESSAGE WERE OUTPUT

104	CONTROL/C NEVER GETS SET IF THE PROGRAM HAS SET OLDTT.  MAKE
	SURE CONTROL/C GETS SET IF WHEN THE FLAG GETS SET NOT AFTER.

105	CONTROL/S, CONTROL/Q ARE TRAPPED AND THUS NOT OPERATIONAL. ON
	TERMINALS WHICH HAVE SILO'S THIS CAN LOOSE IF THE TERMINAL
	SENDS A CONTROL/S WHEN ITS SILO FILLS UP.  ALLOW THE DEFAULT
	TO MAKE THIS OPERATIONAL, BUT ALLOW IT TO BE CHANGED WITH
	TFRSYS.

106	RUBOUT IS NOT OPERATIONAL.  THE REASON FOR RUBOUT NOT DOING
	ANYTHING HAS BEEN LOST IN ANTIQUITY.  AS A DEFAULT MAKE IT
	ACT AS A BACKSPACE.  IF THE USER WANTS IT TO DO NOTHING,
	THEN ALLOW IT TO BE SET VIA TFRSYS.

107	TFR.MAC ONLY.  ADD ADDITIONAL STUFF TO THE SUMMARY LISTING.

110	CHANGE THE WAY TRAFFIC STORES NEGATIVE NUMBERS FROM LEADING SIGN
	TO OVERPUNCHED TRAILING DIGIT.  THIS WILL INSURE THAT IT WORKS
	IN ALL CASES.  PROBLEMS REPORTED WITH PROGRAMS MOVING NEGATIVE
	NUMBERS TO OTHER DATA TYPES OF FEWER DIGITS, AND SIGN GETTING
	TRUNCATED.  CANNOT CAUSE THIS UNLESS LEADING DIGIT IS ALSO
	TRUNCATED, BUT THIS FIX WILL NARROW DOWN THE PROBABILITY.
	ALSO DO SOME CLEAN UP WHERE THIS CHANGE TOUCHES OTHER THINGS.

111	FIX A PROBLEM WITH 110 WHICH CAUSES FIELDS WITH BLANK FILLERS
	TO BE DONE WRONG. ANOTHER PROBLEM ASSOCIATED WITH CLEAN UP
	AND CAUSING SUBFIELDS TO TERMINATE IMPROPERLY AFTER A TAB
	WHEN IN FIRST DIGIT OF NEXT SUBFIELD.

***********************************************************************
**** BEGIN VERSION 2A *************************************************
***********************************************************************

112	-----	TFRCOB -- MAKE CHANGES TO WORK WITH TOPS-20
		V4 BREAK MASK FUNCTIONALITY.

113	-----	EDIT 100 SLIGHTLY WRONG, NUMERICS ENDING IN LAST COLUMN 
		(HICOLM) CAUSE CURSOR TO BE MISPLACED WHEN NON-NUMERIC
		CHARACTER IS TYPED.

114	12934	TFR --- IN SOME CASES TFR DOES NOT TOTALLY RESET THE
		'VALUE' PARAMETER FROM ONE FIELD TO THE NEXT.

115	-----	TFRCOB --- IN TABBED OVER PREVIOUS DUPE FIELDS WITH
		SUBFIELDS ARE CHECKED FOR LEGALITY UNNECESSARILY.

116	-----	TFRCOB --- WHEN A LOWER OR UPPER RANGE WAS TURNED OFF BY
		CALLING TFRCHG WITH LOW-VALUES IN THE VALUE FIELD, THE
		INDICATED RANGE WAS GETTING SET TO EITHER 'LOWER' OR
		'UPPER' RESPECTIVELY.

117	13806	TFRCOB -- IF PREVIOUS FORM HAD PREVIOUS-DUPE AND USER TABBED,
		PROTECTED FIELDS OF NEXT FORM WILL BE BLANKED OR ZEROED IN
		WORKING-STORAGE INSTEAD OF SET UP (THEY WILL PRINT PROPERLY
		ANYWAYS).

120	13990	SAVE FILENAMES OF FORMS FILES IN UPPER CASE.

121	13814	TFRCOB -- IN TFRRD, CLEAR TXTTAB+.RDDBC (DESTINATION BYTE COUNT)
		BEFORE READING EACH FIELD, IN CASE WE ARE DEFAULTING (DUE TO
		CR, FF, LF, UP ARROW, OR DOWN ARROW), SO THAT WE DO NOT THINK
		THAT THE SKIPPED FIELDS HAVE A LENGTH.  THIS PREVENTS TROUBLE IF
		WE SKIP A REQUIRED FIELD AND NEED TO POSITION TO IT, AS IF THE
		FIELD WHERE WE HIT THE FORM-ENDING CHARACTER WAS LONGER THAN THE
		COLUMN POSITION OF THE REQUIRED FIELD, WE MAY TRANSMIT A CONTROL
		CHARACTER IN AN EFFORT TO POSITION.  THIS IS BAD IF IT IS, SAY,
		A CONTROL-S.

122	-----	IP20 (EDIT 4) -- ALLOW USER TO ASSEMBLE IN DESIRED IPCF QUOTAS.

123	-----	IP20 (EDIT 5) -----	REPLACE .JBCST WITH .JBPGE,
		.JBCST IS RESERVED FOR CUSTOMER USE; .JBPGE, .JBDDT+5, 
		IS NOT BE USED BY THE TOPS-20 MONITOR
124	-----   QAR   -----  FIX FUNCTION CODE FOR MTOPR IN SETTYP
		ROUTINE OF TFRCOB

125     -----   QAR   -----  WAKE UP PREVIOUS-DUPE FIELDS AFTER
		FIRST CHARACTER TO INITIALIZE FIELD

126	-----	QAR   -----  WAKE UP PROGRAM IF ERROR MESSAGE ON
		SCREEN MUST BE CLEARED

	***** END REVISION HISTORY *****

	^

	ENTRY	TFRINI,TFRCLR,TFRWRT,TFRRD,TFRERR,TFRCHG
	ENTRY	TFRSYS,TFRRST,TFRRWT,TFRSET,TFRFNO
	SEARCH	MONSYM,MACSYM
	SEARCH	TFRUNV
REMARK	ASSEMBLY SWITCHES


;	FTARGS==0 ............. DONT CHECK NUMBER OF ARGS
;	FTARGS==1 ............. DO   CHECK NUMBER OF ARGS
	FTARGS==1

	IFNDEF COB%VR, <COB%VR=+1>	;COBOL VERSION; 0=12,+1=11 AND 12
	;[37] START OF SYMBOLS

		;THE INTERPRETATION OF REQUIRED FIELDS HAS CHANGED
		; FROM THE OLD (AND ERRONEOUS WAY). BUT BECAUSE
		; PEOPLE MAY BE UTILIZING THESE LIMITATIONS AS
		; FEATURES, THE OLD WAY CAN BE PRESERVED BY SETTING
		; THE FOLLOWING SWITCHES TO -1.

	IFNDEF OLD%TT, <OLD%TT=-1>	;[43]=-1 THEN TERMINAL MODE IS SET ON
					;[43] EACH CALL TO A TFR??? ROUTINE.
					;[43]THIS WILL INSURE THAT THE
					;[43] TERMINAL CHARACTERISTICS ARE
					;[43] SET PROPERLY.  =0, THEN THIS
					;[43]FAIRLY EXPENSIVE PROCEDURE IS
					;[43]NOT DONE EXCEPT WHEN THE USER
					;[43]EXPLICITLY CALL TFRSET.

	IFNDEF OLD%CR, <OLD%CR=0>	;=0CARRIAGE RETURN GIVES 'END-INDICATOR'
					; OF 5. IF -1, THEN GIVES VALUE OF 3.

	IFNDEF OLD%AR, <OLD%AR=0>	;LEFT AND RIGHT ARROWS FUNCTIONS AS BACKSPACE
					; AND TAB RESPECTIVELY. IF -1, THEN
					; GIVES SAME 'END-INDICATOR' AS CR.

	IFNDEF OLD%RQ, <OLD%RQ=0>	;REQD ATTRIBUTE IS INDEPENDENT
					; OF ALL OTHERS.
	IFNDEF OLD%YN, <OLD%YN=0>	;YES/NO FIELDS NOT NECESSARILY
					; REQUIRED.
	IFNDEF OLD%ZR, <OLD%ZR=0>	;BLANK FILL NUMERICS ON SCREEN
					; WHEN RIGHT JUSTIFIED.
	IFNDEF OLD%MD, <OLD%MD=0>	;IF USER BYPASSES AN OPTIONAL
					; MASTER DUPE FIELD, DO NOT
					; DELCARE IT MASTER DUPPED WITH
					; BLANKS OR ZEROS.

	IFNDEF OLD%PR, <OLD%PR=0>	;RESET THE ATTRIBUTES FROM THE
					; FORM FILE WHENEVER A FIELD
					; IS INITED.

	IFNDEF OLD%RN, <OLD%RN=0>	;0=,THEN REWRITE NUMERICS RIGHT
					;   JUSTIFIED. ELSE DO NOT (THIS
					;   MAY BE DESIRABLE WITH EXPER-
					;   IENCED USERS ON SLOW TERMINALS.

	IFNDEF OLD%WR, <OLD%WR=0>	;0=ALL TFRWRT TO FIELDS TO CAUSE
					;  INITIALIZATION (NEW)
					;-1=TFRWRT TO UNITIALIZED FIELDS
					;	FAILS.
	IFNDEF OLD%UD, <OLD%UD=0>	;0=UP/DOWN ARROW = CARRIAGE RETURN

	IFNDEF OLD%LC, <OLD%LC=0>	;[61]0=NO LOWER CASE, -1 LOWER CASE.
	IFNDEF OLD%CC, <OLD%CC=0>	;[72]0=NO CONTROL/C TRAPPING, 
					;[72]-1=  CONTROL/C TRAPPING.
	IFNDEF OLD%CS, <OLD%CS=-1>	;[105]0=NO ACTION ON CONTROL/S,CONTROL/Q
					;[105]-1=ALLOW MONITOR XON/XOFF FUNCTIONALITY

	IFNDEF OLD%RB, <OLD%RB=-1>	;[106]0=NO ACTION ON RUBOUT
					;[106]-1=RUBOUT SAME AS BACKSPACE.
;**; [112] INSERT AFTER DEFINITION OF OLD%RB	CLRH	28-JUL-80
	IFNDEF BRK%128, <BRK%128=-1>	;[112] 0 = RUN WITHOUT 128 CHARACTER BREAK.
					;[112] -1 = RUN WITH 128 CHARACTER BREAK
					;[112]      (TOPS20 V4 ONLY)

	IF1, <FT2SEG==0		;ONE SEGMENT CODE>
	IF1 <
;		IFE COB%VR,<PRINTX TFRCOB WORKS ONLY WITH V12 OF LIBOL
;				FT2SEG==1		;TWO SEGMENT CODE
;			    >
;		IFE COB%VR+1,<PRINTX TFRCOB WORKS ONLY WITH V11 OF LIBOL>
;		IFE  COB%VR-1,<PRINTX TFRCOB WORKS WITH BOTH V11 AND>
;		IFE  COB%VR-1,<PRINTX	V12 OF LIBOL>>
	OPDEF	PJRST	[JRST]	;JRST TO ROUTINE WHICH RET'S
	OPDEF	EXTEND	[123000,,000000]	;FOR KL
	OPDEF	MOVSLJ	[016000,,000000]	;FOR KL
	OPDEF	MOVSRJ	[017000,,000000]	;FOR KL
	OPDEF	MOVST	[015000,,000000]	;TRANSLATE
	OPDEF	CMPSE	[002000,,000000]	;FOR KL
	OPDEF	CMPSG	[007000,,000000]
	OPDEF	CMPSL	[001000,,000000]
	OPDEF	ADJBP	[IBP  0,0(0)   ]	;FOR KL

	F=0			;INTERNAL FLAGS
	A=1
	B=2
	C=3
	D=4
	E=5
	INT.A=6
	INT.B=7
	INT.C=10
.WD1=11		;HOLD AREA FOR A FIELDS DATA WORDS
	WD1=11
	WD2=12
	WD3=13
	WD4=14
	WD5=15
	PRM=11
	ARG=16
	P=17

	PG2ADR=^D9		;SHIFT FOR PAGE# TO ADDRESS
	ADR2PG=-^D9		;SHIFT FOR ADDRESS TO PAGE#
	RUBOUT=177		;ASCII VALUE FOR RUBOUT
	BACKSP=10		;ASCII VALUE FOR BACKSPACE


REMARK	ERROR CODE DEFINITIONS; RETURNED TO COBOL

	ERR.BA==1		;BAD ARGUMENT IN CALL
	ERR.UF==2		;UNDEFINED FILE-NAME
	ERR.NF==3		;FIELD-ID WAS NOT FOUND
	ERR.ND==4		;FIELD-ID IS NOT DISPLAYED
	ERR.IA==5		;INVALID ATTRIBUTE (TFRCHG)
	ERR.FE==6		;FATAL ERROR - INTERNAL GOOF
	ERR.WL==7		;WRONG LENGTH RECD DESC IN PGM.
	ERR.DP==^D8		;[35]PMAP FAILURE FROM FORM FILE.
;	ERR.SP==^D9		;[35]NOT ENOUGH PAGES ALLOCATED
	ERR.NC==^D10		;[35]LIBOL DID NOT RETURN ENOUGH PAGES.
	ERR.IV=^D11		;[53]TFRSYS CALL WITH BAD VARIABLE#
	ERR.NV=^D12		;[53]TFRSYS CALL WITH NEW-VALUE NOT 0,-1.

	DEFINE LBL(N)
<
HISTEP=N
>

	DEFINE LABELZ(HI,LO)
<
%'HI'.'LO':	>

;[40]	DEFINE HIPO(STEPX,MSG,NEXTX)
;[40]< 
;[40]IFNB <STEPX>,<
;[40]LABELZ \HISTEP,STEPX>
;[40]  >;END DEFINE HIPO

REMARK	DEFINE INTERNAL STORAGE LOCATIONS

REMARK	GENERATE THE REQUIRED POINTERS TO DATA & STRINGS

	DEFINE	LOAD(REX,PTR,TMP<E>)
<
	MOVE	TMP,PTR
	ADDI	TMP,.WD1
	LDB	REX,TMP
>

	DEFINE	STORE(REG,PTR,TMP<E>)	;STORE A VALUE AWAY
<
	MOVE	TMP,PTR			;GET THE RELATIVE POINTER
	ADDI	TMP,.WD1		;ADD IN REG DISPLACEMENT
	DPB	REG,TMP			;SAVE VALUE IN REGS.
	MOVE	TMP,PTR			;GET PTR AGAIN
	ADD	TMP,FLDPTR		;POINT TO CORE TABLE
	DPB	REG,TMP			;& SAVE THERE TOO.
>	;END OF STORE

;;; DO NOT EXPAND MACROS

;;;
IFN	FT2SEG,<TWOSEG
		RELOC 400000>	;RELOC TO HI SEG IF REENTRENT SWITCH ON.

	PTRGEN
HICOLM:	^D80			;HIGHEST COLUMN ALLOWED
CURFRM:	POINT 7,FRMFIL		;POINTER TO CURRENT FORM STRING.

;**; [112] REPLACE AT TXTNUM	CLRH	28-JUL-80
;[112]TXTNUM:				;NUMERICS ONLY - BREAK ON ALL OTHERS
;[112]	-1			;0 - 37
;[112]	^B111111111111111100000000001111111111 ;NUMERICS
;[112]	-1
;[112]	-1
;[112]
;[112]TXTAN:				;ALPHANUMERICS A-Z AND 0-9
;[112]	-1 ;0 - 37
;[112]	0			;SPECIAL CHAR & NUMERICS
;[112]	^B1			;UPPER CASE, BRACKETS, BACKSLASH
;[112]	-1
;[112]
;[112]TXTA:				;ALPHABETICS ONLY!
;[112]	-1
;[112]	-1
;[112]	^B100000000000000000000000000111111111
;[112]	-1
;[112] THE BREAK MASKS WHICH ARE NOT USED IN TRAFFIC-20 V2 HAVE BEEN
;[112] REDEFINED FOR USE WITH THE 128 CHARACTER BREAK SET FEATURES
;[112] OF TOPS-20 V4 -- AND RENAMED.

;CONSTANTS:				;[112]
	ALLMSK=777777,,777777		;[112] NOTHING LEGAL
	NUMMSK=777774,,001777		;[112] NUMBERS ONLY ARE LEGAL
	LETMSK=400000,,000777		;[112] LETTERS ONLY
	SPCMSK=377777,,777777		;[112] ALLOW BLANK TO BE LEGAL

MSK.NO:	4				;[112] MASK FOR NUMBERS ONLY
	ALLMSK				;[112] 0-37 ILLEGAL
	NUMMSK				;[112] 40-57 ILLEGAL, 60-71 LEGAL, 72-77 ILLEGAL
	ALLMSK				;[112] 100-137 ILLEGAL
	ALLMSK				;[112] 140-177 ILLEGAL

MSK.AO:	4				;[112] MASK FOR ALPHABETICS ONLY WITHOUT A SPACE
	ALLMSK				;[112]
	ALLMSK				;[112]
	LETMSK				;[112] UPPER CASE LETTERS
	LETMSK				;[112] LOWER CASE LETTERS

MSK.AB:	4				;[112] MASK FOR ALPHABETICS ONLY WITH A SPACE
	ALLMSK				;[112]
	SPCMSK				;[112] ALLOW THE SPACE (40)
	LETMSK				;[112] UPPER CASE
	LETMSK				;[112] LOWER CASE

MSK.AN:	4				;[112] MASK FOR ALL ALPHANUMERICS AND PUNCTUATION
	ALLMSK				;[112]
	0				;[112]
	0				;[112]
	37				;[112]

MSKTAB:	MSK.NO				;[112] TABLE OF MASKING ARGUMENT BLOCKS
	MSK.AO				;[112] INDEXED INTO FOR CORRECT BLOCK
	MSK.AB				;[112]
	MSK.AN				;[112]


REMARK	INTERNALLY GENERATED ERROR MESSAGES FOLLOW (INTERR)

MSG.NN:	ASCIZ	^ENTER NUMBERS ONLY^
MSG.NA:	ASCIZ	^ENTER LETTERS OR NUMBERS ONLY^
MSG.AO:	ASCIZ	^ENTER LETTERS ONLY^
MSG.RQ:	ASCIZ	^A VALUE MUST BE ENTERED^	;;[3] SPELLING FIX
MSG.FF:	ASCIZ	^FIELD MUST BE FILLED^
MSG.ID:	ASCIZ	^INCORRECT DATE^
MSG.YN:	ASCIZ	^ENTER Y OR N^
MSG.BU:	ASCIZ	^CAN'T BACK UP FURTHER^
MSG.ES:	ASCIZ	^INVALID CHARACTER AFTER <ESC>^
MSG.LR:	ASCIZ	^LOWER LIMIT IS ^
MSG.UR:	ASCIZ	^UPPER LIMIT IS ^
CHNTAB:	1,,IGNORE	;;[2] IGNORE IS HIGHEST PRIORITY
;[15]	2,,TYPEIN	;;[2] TYPEIN IS DEFERRED
			;TYPIN DONE - CLEAR ERROR LINE

IGNORE:	DEBRK		;;[2] IGNORE IS AN ACTIVE CHANNEL

REMARK	TERMINATOR CODES (TFRRD - INTRD)

	TRM.LN==1
	TRM.TB==2
	TRM.LF==3
	TRM.FF==4
	TRM.CR==5
REMARK	TABLES FOR RANGE CHECKING

	DEFINE	TBL(ENT,PTR)
<	[ASCIZ ^ENT^],,PTR   >


	DEFINE .CALL.
<	 SKIPA 777		;[63]ALLOW 'CALL' STATEMENTS
	  XWD [0],%FILES>	;[63] TO WORK.

	DEFINE	ENTER(NAME,NUMARG,NUMAR2,%%OK) ;[7]
<				;[7]
NAME::				;[7] DEFINE ENTRY POINT
	.CALL.			;[63]COBOL 'CALL' ENTRY.
IFN FTARGS,<			;[7]
	HLRE A,-1(ARG)		;[7] GET MINUS ARG NUMBER
	MOVMS A			;[7] GET MAGNITUDE
IFNB <NUMAR2>,< CAIE A,NUMAR2>	;[7]
	CAIN A,NUMARG		;[7] RIGHT NUMBER ?
	JRST %%OK		;[7] YES - ALL OK
	TMSG <?NAME CALLED WITH WRONG NUMBER OF ARGS> ;[7]
	HALTF			;[7]
%%OK:				;[7]
	    >			;[7]
	SKIPE OLDTT		;[55]IF WE MUST CHECK TERMINAL STATUS
	 CALL $TTCHK		;[55]  ON EACH CALL, DO IT (ALAS).
> ;END ENTER			;[7]

REMARK	TFRCHG ATTRIBUTE TABLES

CGTBL:	^D12,,^D12
TBL	<ALPHABETIC>,CGAB
TBL	<ALPHANUMERIC>,CGAN
TBL	<LOWER-RANGE>,CGLR
TBL	<MASTER-DUPE>,CGMD
TBL	<NO-DUPE>,CGND
TBL	<NUMERIC>,CGN
TBL	<OPTIONAL>,CGO
TBL	<PREVIOUS-DUPE>,CGPD
TBL	<PROTECTED>,CGP
TBL	<REQUIRED>,CGR
TBL	<UNPROTECTED>,CGUP
TBL	<UPPER-RANGE>,CGUR

;[16]
COMMENT +
	BUILD UP  TABLES FOR CHECKING THE DATE FIELDS FOR
	LEGAL FORMAT.

		THEY ARE:

			MMMTAB -- ASCII 3 LETTER APPREVIATION FOR MONTH
			MNMTAB -- ASCII 2 DIGIT NUMBER OF MONTH
			MLDTAB -- ASCII 2 DIGIT MAX DAYS IN MONTH
	+

	DEFINE MONTHS,<
		MM JAN,01,31
		MM FEB,02,29
		MM MAR,03,31
		MM APR,04,30
		MM MAY,05,31
		MM JUN,06,30
		MM JUL,07,31
		MM AUG,08,31
		MM SEP,09,30
		MM OCT,10,31
		MM NOV,11,30
		MM DEC,12,31 >

	DEFINE MM (A,B,C),<
		"A">
	MMMTAB:	MONTHS


	DEFINE MM (A,B,C),<
		"B">
	MNMTAB:	MONTHS


	DEFINE MM (A,B,C),<
		"C">
	MLDTAB:	MONTHS

;[16]  END OF MONTH TABLES FOR EDIT [16]

	SALL
	SUBTTL	TFRINI - INITAILIZE CALL FROM COBOL
	LBL 2

COMMENT	+
	CALL TFRINI (REC-PTR TFR-PTR FIELD-ID ERR)
	RETURN (ERR)
	+

TFRINI:
ENTER	FRMINI,4		;[7]

	CALL $TTOPN		;  THEN OPEN IT (SETS TTOPN TO -1).
	CALL $SBEGIN		;[64]SETUP THE OUTPUT BUFFER
	SETOM	COBCAL		;INDICATE COBOL CALL
	MOVE	A,@0(ARG)	;GET RECORD POINTER
	MOVEM	A,RECPTR	;AND SAVE IT
	CALL CHKFORM		;USING CURRENT FORM FILE ?
	 JRST %2.14		;GOOD FORM NAME BUT NO FIELDS IN IT.
	 JRST %2.14A		;COULD NOT LOAD THE FORM.
	 JFCL			;EVERYTHING IS IN GOOD SHAPE.

%2.3:		;ON COBOL CALL, SETUP TO FIND THE FIRST FIELD.

	MOVEI	INT.A,@2(ARG)	;GET W.S. POINTER
	HRRZ	INT.B,1(INT.A)
	MOVE	INT.A,0(INT.A)
	SKIPA			;SKIP COBCAL SETTING
INITAL:				;INTERNAL CALL TO INIT EVERYTHING
				;INT.A MUST HAVE FIELD PTR
	SETZM	COBCAL		;INDICATE INTERNAL CALL
	CALL	FIND
	 JRST %2.14		;NOT FOUND
	 JRST %2.11		;NO MORE FIELDS
	 JFCL			;GOT A FIELD
	SKIPE COBCAL		;[22] IF WE ARE IN AN INIT CALL
	 CALL GETPRM		;[22]  THEN SET UP NEW STATUS BITS.
	TXNE PRM,MSDUP%		;IF MASTER DUPE IS ON
	 TXZ PRM,PRDUP%		;  THEN RESET TO INDICATE NOT FILLED.
	TXNE PRM,PROT%		;IF A PROTECTED FIELD
	 JRST %2.8		;   THEN DO NOT REFORMAT.
	CALL FORMAT		;FORMAT FIELD IN WORKING-STORAGE
;[41]	CALL WS2VAL		; AND THEN REFORMAT INTERNAL VALUE.

%2.8:		;;WRITE THE FIELD TO THE SCREEN

	TXNN	PRM,%DSPLY	;IF THE FIELD IS NOT ON THE SCREEN
	;[111]  --AT LINE %2.8+4 IN SOURCE
	JRST	[TXNE PRM,PROT%	;[111]IF PROTECTED FIELD 
		  CALL WRITE	;[111]  THEN WRITE OUT FIELD
		CALL FILL	;  AND THEN FILL OUT REST
		JRST %2.10]	;   AND CONTINUE.
	TXNN PRM,PROT%		;  ELSE IF FIELD IS UNPROTECTED
	 CALL BLANK		;      MERELY BLANK IT.
%2.10:		;;INDICATE FIELD IS ON THE SCREEN

	TXO	PRM,%DSPLY
	TXNE	PRM,PROT%	;DON'T SAY PROT FIELDS ARE EMPTY!!
	 JRST	%2.10A
	SETZ	A,
	CALL	SV.NUMRD
%2.10A:

	CALL	STRPRM		;STORE PARAMETERS BACK
	CALL $SCHKPNT		;[64]WRITE OUT BUFFER IN ROOM NEEDED
	SKIPE	COBCAL		;COBOL CALL ?
	 JRST	%2.3		;YES--GO FOR MORE FIELDS
	JRST INITAL		;NO--RETURN FOR NEXT FIELD,



%2.11:		;NO MORE FIELDS TO INITIALIZE

;[41]	CALL $HOME		;HOME THE CURSOR
	CALL $SEND		;[64]SEND TERMINAL MESSAGE.
	SETZB A,CURERR		;INITIALIZE TO 'NO ERROR'.
	SKIPE	LENERR		;ANY LENGTH ERRORS
	 JRST	[SETZM LENERR
		 MOVEI A,ERR.WL
		 JRST .+1]
	SKIPE	COBCAL		;SKIP IF NOT COBOL CALL
	 MOVEM	A,@3(ARG)
	RET


%2.14:		;;RETURN THE 'NOT FOUND' ERROR
	MOVEI	A,ERR.NF	;NOT FOUND !
%2.14A:		;;ERROR RETURN -- CONTENTS OF A INDICATES WHICH.
	MOVEM	A,CURERR
	SKIPE	COBCAL
	 MOVEM	A,@3(ARG)	;NOT FOUND ERROR
	RET
	PAGE
CHKFORM:		;CHECK CALLER'S FORM DESCRIPTION AND OPEN
			; NEW FORM FILE IF NECESSARY.


	MOVEI	B,@1(ARG)	;FORM PTR
	HRRZ	A,1(B)		;COBOL LENGTH
	MOVE	B,0(B)		;BYTE PTR
	TLNN	B,100		;ASCII ?
;**; [120] INSERT AT CHKFORM + 3 1/2	CLRH	26-FEB-80
	 JRST	%2.19		;[120] SIXBIT, SO SKIP THIS
	CALL	INT72U		;[120] CONVERT ASCII TO UPPERCASE ASCII IN INTBUF
	SKIPA			;[120] SKIP OVER SIXBIT CONVERSION
%2.19:	 CALL	INT627		;NO - CONVERT SIXBIT TO ASCII IN INTBUF
	MOVEI	D,130		;DEST LENGTH IN BYTES
	MOVE	E,CURFRM	;BUFFER PTR
	SKIPE GOTFIL		;[35] IF NO FILE, THEN NO COMPARE
	 EXTEND	A,[CMPSE	;COMPARE-SKIP EQ
		   " "		;SPACE FILL BOTH
		   " "]
	  SKIPA			;NOT THE SAME--OPEN NEW FILE.
	  JRST SKPRT2		;GIVE GOOD RETURN.
;**; [117] INSERT AT CHKFORM + 13	CLRH	25-FEB-80
	SETZM	ISTAB		;[117] ON NEW FORM, CLEAR PREVIOUS-DUP TABBED FLAG
	CALL INITAB		;[67]INITIALIZE THE SECTION/FIELD TABLES
	MOVEI	INT.A,@1(ARG)	;POINTER TO NAME DATA BLOCK
	CALL	GETFIL		;GET JFN FOR FILE + OPEN
	 JRST	[MOVEI A,ERR.UF ;UNKNOWN FILE NAME
		 SETZM GOTFIL	;[65]ON ERROR INDICATE NO FILE NAME.
		 JRST SKPRT1]	;INDICATE UNKNOWN FILE NAME.
	 JFCL			;FILE FOUND AND OPENED.
	CALL	SETINT		;ENABLE FOR INTERUPTS
	CALL	MAPIN		;MAPIN THE DATA FILE
	 JRST SKPRT1		;[35]NOT ENOUGH MEMORY FOR FORM.
;[35]	LDB A,.NMFLD		;GET NUMBER OF FIELDS
	MOVE B,.NMFLD		;[35]GET THE POINTER TO #FIELDS
	SUB B,V11DAT		;[35] OFFSET TO NEW PAGE
	ADD B,V12DAT		;[35]
	LDB A,B			;[35]
	MOVEM	A,HIFLD		;SAVE IT

		; COPY ALL DATA TO WORKING-STORAGE
%2.18:
	SETZ	INT.A,		;FLD-PTR = 0; DO ALL FLDS ON INIT
	CALL	FIND		;FIND A DATA FIELD
	 RET			;NO FIELDS FOUND -- RETURN AN ERROR.
	 JRST	%2.A20		;NO MORE, WE ARE DONE.
	 JFCL			;WE FOUND IT.
	CALL LD.NUMRD		;[66]GET NUMBER OF CHARS IN FIELD.
	MOVE B,LENFLD		;[66] AND LENGTH OF FIELD
	CAILE A,(B)		;[66]IF NUM .GT. LENGTH
	 MOVEI A,(B)		;[66]  THEN TAKE LENGTH
	CALL SV.NUMRD		;[66]    AND SAVE THE LENGTH
	CALL SETTAB		;[67]SETUP SECTION AND FIELD TABLES
	CALL GETPRM		;SET UP THE 'PRM' AC.
	CALL FORMAT		;FILL WORKING STORAGE WITH SPACES OR ZEROS.
	TXNN PRM,%PROT		;IF FIELD IS UNPROTECTED
	 JRST %2.18		;   THEN DO NO FURTHER PROCESSING.
	CALL LD.NUMRD		;GET NUMBER CHARS IN FIELD
	CALL REFORM		;MOVE DATA FROM 'VALUE' TO WORKING
	 JFCL			;   STORAGE.
	JRST	%2.18


%2.A20:		;;VERIFY RECORD LENGTH IS CORRECT
	SETZM	LENERR
	LOAD	A,.OFFST	;OFFSET OF LAST FIELD
	ADD	A,LENFLD	;PLUS LENGTH
	MOVEI	B,@0(ARG)	;SHOULD EQUAL ...
	HRRZ	B,1(B)		;... LENGTH OF RECORD.
	CAME	A,B		;THEY SHOULD BE EQUAL.
	 SETOM	LENERR
;[35]	LDB	A,.ERRNM
	MOVE B,.ERRNM		;[35] GET ERROR LINE NUMBER AFTER
	SUB B,V11DAT		;[35]  BY OFFSETTING
	ADD B,V12DAT		;[35]   TO THE PROPER PAGE
	LDB A,B			;[35]AND THEN APPLYING THE BYTE POINTER.
	SKIPN	A		;SKIP IF NON-ZERO
	 CALL	SETERL		;IF ZERO, SET ERR-LINE IN A
	MOVEM	A,ERRLIN

		;CLEAR THE SCREEN AND THE INPUT BUFFER.

	CALL $CLEAR
	CALL $CLIBF		;CLEAR THE INPUT BUFFER.
	JRST SKPRT2		;RETURN TO CALLER.

	PAGE
	SUBTTL TFRINI -- SECOND LEVEL SUBROUTINES

GETPRM:  ;[22] ROUTINE TO RESET THE TEMPORARY ATTRIBUTES OF THE FIELD
	 ;[22]   WITH THE INITIAL (FORM DEFINED) STATUS.

	LDB A,[POINT 5,PRM,23]	;[22] GET REQ,FULL,PROT,MSD,PRED
	DPB A,[POINT 5,PRM,13]	;[22]  AND PLACE IN TEMPORARY POSITIONS.
	LDB A,[POINT 4,PRM,31]	;[22] GET RANGU,RANGL,ALPHA,NUMER
	DPB A,[POINT 4,PRM,17]	;[22]  AND PLACE IN TEMPORARY POSITIONS.
	SKIPN OLDRQ		;[37]IF NEW REQUIRED INTERPRETATION
	 RET			;[22] RETURN TO CALLER
	TXNE PRM,%YN		;[37] ELSE SET REQUIRED IF
	 TXO PRM,REQD%		;[37]   YES/NO
	TXNE PRM,%RANGE		;[37]   RANGE CHECKING
	 TXO PRM,REQD%		;[37]
	TXNE PRM,%FULL		;[37]   FULL FIELD NEEDED.
	 TXO PRM,REQD%		;[37]
	RET			;[37]

SETINT:
	MOVEI	A,.FHSLF
	RIR
	HRLI	B,0
	MOVE	A,CHNTAB
	MOVEM	A,0(B)
;[15]	MOVE	A,CHNTAB+1
;[15]	MOVEM	A,1(B)
	RET

RSTINT:
	RET


SKPRT2:	AOS (P)			;RETURNS
SKPRT1: AOS (P)
	RET

	PAGE
;[67] INITIALIZE AND SET UP FIELD/SECTION TABLES FOR PERFORMANCE


INITAB:		;INITIALIZE THE TABLES

	SETZM SECTAB		;INITIALIZE THE SECTION TABLE
	MOVE A,[SECTAB,,SECTAB+1] ;BY STORING ZEROS IN IT.
	BLT A,SECTAB+^D28

	SETZM FLDTAB		;INITIALIZE THE FIELD TABLE
	MOVE A,[FLDTAB,,FLDTAB+1] ;BY STORING ZEROS IN IT.
	BLT A,FLDTAB+FLDTLN+1	
	RET
SETTAB:		;SET UP FIELD AND SECTION TABLES
		; FOR SCANNING THE FORM FILE

		;ON ENTRY -- THE CURRENT FIELD IS SETUP AND
		; THE TABLES (SECTAB, FLDTAB) HAVE BEEN
		; INITIALIZED, OR ARE IN USE.

		;TABLES HAVE ENTRIES WHICH HAVE:
		;	LOWEST FIELD NUMBER,,HIGHEST FIELD NUMBER

	CALL SETSEC		;SET THE SECTION TABLE
	CALL SETFLD		;SET THE FIELD TABLE
	RET





SETSEC:		;SET THE SECTION TABLE.

		;THE SECTION TABLE HAS 28 ENTRIES INDEXED BY THE
		; SECTION NUMBER.

	LOAD B,.SECTN		;GET THE SECTION BITS FOR THIS FIELD
	SETZ A,			;INITIALIZE SECTION TABLE INDEX.
	MOVE C,CURFLD		;GET NUMBER OF CURRENT FIELD.
	SKIPA			;SKIP OVER NEXT INSTRUCTION
SETSLP:	 LSH B,-1		;PUT NEXT SECTION BIT IN LOW ORDER POSITION.
	SKIPN B			;IF NO MORE SECTIONS
	  RET			;  THEN DONE
	AOS A			;INCREMENT SECTION TABLE INDEX
	TRNN B,1		;IF THIS SECTION DOES NOT HAVE BIT SET
	 JRST SETSLP		;  THEN GO TO NEXT SECTION
	SKIPN SECTAB(A)		;  ELSE IF FIRST FIELD IN THIS SECTION
	 HRLM C,SECTAB(A)	;    THEN STORE FIELD NUMBER IN LH.
	HRRM C,SECTAB(A)	;   AND STORE IN RH ANYWAY.
	JRST SETSLP		;NEXT FIELD.
	PAGE
SETFLD:		;SET THE FIELD TABLE UP.
		;EACH FIELD-NAME IS HASHED INTO THE TABLE AND
		;THE LEFT AND RIGHT HALVES OF THE TABLE ARE SET
		;WITH THE LOWEST AND  HIGHEST FIELD-NAME WHICH 
		;HASHES TO THIS ENTRY. THIS LIMITS THE SCAN NECESSARY
		;FOR 'FIELD-NAME SEARCHES'.

	LOAD B,.FIELD,C		;GET ADDRESS OF THIS FIELD NAME
	SUB B,V11SYM		;OFFSET TO THE CORRECT
	ADD B,V12SYM		; TO THE CORRECT PAGE
	HRLI B,(POINT 7,0)	;MAKE A BYTE POINTER
	MOVEI A,^D30		;A MAX OF 30 CHARACTERS IN A NAME
	CALL FLDHSH		;GET AND HASH THE FIELD NAME.
	MOVE C,CURFLD		;GET THE FIELD NUMBER
	SKIPN FLDTAB(B)		;IF ENTRY HAS NOT BEEN SET
	 HRLM C,FLDTAB(B)	; THEN THIS IS LOWEST NUMBER.
	HRRM C,FLDTAB(B)	;THIS IS HIGHEST NUMBER ANYWAY.
	RET			;DONE

FLDHSH:		;HASH FIELD NAME AND LEAVE 'A'.
		; ON EXIT HASHED TABLE ENTRY IN 'B'.

	DMOVE D,[^D40		;SETUP THE '2' ADDRESS
		POINT 7,INTBUF]	; AND LENGTH
	CALL MOV6OR7		;MOVE FIELD NAME TO INTBUF IN ASCII
	SETZB A,B		;AND FILL OUT REST OF THE AREA
	EXTEND A,[MOVSLJ	;WITH SPACES
		 " "]
	 JFCL
	MOVE A,INTBUF		;INITIALIZE WITH FIRST WORD OF NAME.
	MOVEI B,1		;START ON SECOND WORD
FLDHLP:	LSH A,-2		;SHIFT OFF BOTTOM 2 BITS
	MOVE C,INTBUF(B)	;GET NEXT WORD
	CAMN C,[ASCII/     /]	;IF WORD CONTAINS ALL BLANKS
	 JRST FLDHDV		;  THEN WE ARE DONE WITH COLLECTION
	LSH C,-2		;SHIFT DOWN TWO BITS
	ADD A,C			;ADD INTO TOTAL
	AOS B			;GET NEXT WORD INDEX
	JRST FLDHLP		; AND CONTINUE AROUND.

FLDHDV:		;ACCUMULATED TOTAL IS IN 'A'
	MOVMS A			;MAKE SURE IT IS POSSITIVE
	IDIVI A,FLDTLN		;DIVIDE BY THE FIELD TABLE LENGTH
	AOS B			;LEAVING TABLE OFFSET (1-31) IN 'B'.
	RET			;RETURN TO CALL

;[67] END OF TABLE SETTING ADDITION
	SUBTTL	INITSD - INIT NON-DUPED FIELDS
	LBL 3

INITSD:

		;FIND THE NEXT FIELD
	CALL	FIND		;INT.A MUST BE SET-UP
	 RET			;FIELD NOT FOUND
	 JRST SKPRT1		;NO MORE FIELDS.
	 JFCL			;FIELD IS FOUND.

	TXNN	PRM,%DSPLY	;IF FIELD IS NOT ON THE SCREEN
	 JRST INITSD		;[17]  THEN BYPASS IT.

	TXNE	PRM,PRDUP%	;[24]IF THIS IS A PREVIOUS DUPE FIELD
	 JRST INITSD		;[24]  OR MASTER DUPE WITH FLAG SET THEN BYPASS IT ALSO.

	TXNE	PRM,PROT%	;[24]IF THIS IS A PROTECTED FIELD.
	 JRST INITSD		;  THEN SKIP THIS FIELD.

	CALL FORMAT		;OTHERWISE BLANK OUT WORKING STORAGE.
	CALL BLANK		;THEN SEND BLANKS TO THE SCREEN.
;[41]	CALL WS2VAL		;COPY WORKING STORAGE BACK TO THE LOCAL
	SETZ	A,		;AND FINALLY INDICATE ZERO CHARACTERS
	CALL SV.NUMRD		; IN THE FIELD.
	CALL $SCHKPNT		;[64]WRITE IT OUT IF ROOM NEEDED
	JRST INITSD		;THEN LOOP FOR  NEXT FIELD.
	SUBTTL	WRITE	- WRITE A FIELD TO THE SCREEN

WRITE:
	CALL LD.NUMRD		;GET NUMBER OF CHARS IN FIELD.
	SKIPG C,A		;ANY TO WRITE ?
	 RET			; NO!
	DMOVE A,LINFLD		;LINE AND COLUMN ON SCREEN
	CALL $POSIT		;MOVE THE CURSOR THERE.
	TXNN	PRM,%SSN!%DATE!%MONEY ;SPECIAL SUB-FIELD WRITE ?
	 JRST	WRT1FD		;NO - JUST DO ONE
	MOVEM	C,YET2WT	;# REMAINING TO WRITE

SUBWRT:		;HANDLE SUB-FIELD WRITES
	CALL	SUBFLD
	 RET			;DONE
	JUMPE C,SUBWR5		;PUNT THE EMPTY FIELDS
	CAMLE	C,YET2WT	;ENOUGH LEFT TO WRITE?
	 MOVE	C,YET2WT	;NO-USE THOSE LEFT
	JUMPE	C,RSTRET	;PUNT IF NO MORE DESIRED
	MOVN	E,C		;SUB FROM # REM
	ADDM	E,YET2WT

REMARK	SEPR CHAR IF NEEDED

SUBWR5:	MOVE	E,SUBY
	SOSLE	E
	 CALL	SEPCHR
	CALL	WRT1FD		;WRITE 1 FIELD
	JRST	SUBWRT		;AND GO FOR NEXT

WRT1FD:
	MOVE	B,VALFLD	;FORM W.S. POINTER
	CALL $SSTRING		;[64]SEND STRING TO TERMINAL
	RET			;GO BACK
	SUBTTL	FORMAT	- PUT SPACES INTO WORKING STORAGE 

		;[42] THIS ROUTINE WILL FILL WORKING STORAGE WITH
		;[42]  SPACES FOR ALPHA AND ALPHANUMERIC FIELDS AND
		;[42]  WITH ZEROS FOR NUMERIC FIELDS

FORMAT:
	MOVE	E,OFFFLD
	MOVE	D,LENFLD	;GET LENGTH
	MOVEI A," "		;ASSUME BLANK FILL UNLESS
	TXNE PRM,NUMER%		; THE FIELD IS NUMERIC AND
	 MOVEI A,"0"		; THEN FILL WITH ZEROS BY
	MOVEM A,MOVFILL+1	; STORING THE FILLER CHARACTER
	SETZB A,B		; INDICATING NO 'FROM' FIELD,
	EXTEND A,MOVFILL	; AND THEN SPREADING THE CHARACTER
	 JFCL			; ACROSS THE FIELD.
	RET


;[10]

COMMENT + THIS SECTION ADDED FOR EDIT [10] AND CAUSES NUMERIC 
		VALUES STORED IN PROTECTED FIELDS BY THE
		"VALUE ...." CLAUSE IN THE FORM FILE TO BE
		RIGHT JUSTIFIED.  WITHOUT THIS EDIT, ALL SUCH
		VALUES ARE LEFT JUSTIFIED

	+

	SUBTTL REFWRT - REFORMAT AND WRITE FIELD TO SCREEN.

REFWRT:
	TXNN PRM,PROT%		;IF THIS IS NOT A PROTECTED FIELD
	 RET			;  THEN DO NOTHING.
	CALL LD.NUMRD		;GET NUMBER OF CHARS IN FIELD.
	CALL REFORM		;  ELSE JUSTIFY IN MEMORY.
	 JFCL			;NO BOTHER
	CALL	WRITE		;WRITE TO THE SCREEN
	RET			;ALL DONE

; END OF [10] EDIT
SUBTTL	FIND - FIND THE NEXT DESIRED FIELD
	LBL 11

COMMENT	+
	CALL FIND (FLD-ID)
	 NOT FOUND ERROR
	 NO MORE THIS TYPE
	RETURN (CURFLD SET)
	+

FIND:
	SKIPN GOTFIL		;[101]IF NO FORM INIT HAS BEEN DONE
	 JRST %11.14		;[101]  TELL CALL 'NO FIELD'
	MOVE	A,CURFLD	;SAVE FIRST FIELD
	MOVEM	A,FRSTFD

		;;DISPATCH DEPENDING ON TYPE OF FIELD-NUMBER.
		;;  0 -- FORM
		;; .LT. 0 -- SECTION.
		;; .GT. 0 -- FIELD NUMBER.
		;; ????   -- BYTE POINTER

	JUMPE	INT.A,%11.12	;IF ZERO THEN  IS A FORM.
	HLRE A,INT.A		;LEFT HALF WILL INDICATE TYPE.
	JUMPE A,%11.7		;IF ZERO, THEN IT IS A FIELD NUMBER.
	AOJE A,%11.5		;  THIS IS A SECTION NUMBER.
	JRST %11.9		;OTHERWISE IT IS A FIELD NAME.
	PAGE
;;;;;;;;;;;;;;;;;;  USER HAD SPECIFIED A SECTION NUMBER ;;;;;;;;;;;;;;;;

%11.5:
	SKIPE SECTAB		;[67]IF NOT FIRST FIELD IN SECTION
	 JRST %11.6		;[67]  THEN INITIALIZATION DONE.
	MOVN A,INT.A		;[67]SECTION NUMBER BEING REQUESTED
	CAILE A,^D28		;[67]LEGAL ?
	 JRST %11.13		;[67] NO
	SKIPN A,SECTAB(A)	;[67]GET BEGINNING,,ENDING FIELD NUMBERS.
	 JRST %11.13		;[67]ZERO--NO FIELDS THIS SECTION.
	HRRZM A,SECTAB		;[67]SAVE ENDING FIELD NUMBER.
	HLRZS	A		;[67]GET BEGINNING FIELD #
	SOS A			;[67]MAKE IT THE CURFLD-1
	MOVEM A,CURFLD		;[67] AND UPDATE CURRENT FIELD #
%11.6:
	CALL	GETNXT		;GET NEXT DATA FIELD
	 JRST %11.13		;NO MORE FIELDS.
	 JFCL			;GOT ONE.

	MOVE A,CURFLD		;[67]IF THE CURRENT FIELD NUMBER
	CAMLE A,SECTAB		;[67] IS NOT LESS THAN HIGHEST FIELD #
	 JRST %11.13		;[67]  IN SECTION, THEN WE ARE DONE.

		;;DETERMINE IF WE ARE IN THE CORRECT SECTION.

	MOVE	C,.SECTN	;FORM SECTION POINTER
	ADDI	C,.WD1
	LDB	B,C		;FORM SECTION # - 1
	MOVN	C,INT.A		;FORM SEC # - 1
	SOJ	C,
	MOVEI	A,1		;START WITH SECTION 1
	LSH	A,(C)		;SHIFT (C) PLACES
	TDNE	B,A		;SEE IF BIT IS ON
	 JRST	[MOVE A,CURFLD	;THEN THIS IS A PROPER SECTION.
		 JRST %11.16]	;GOOD SECT = GO DO SET UP OF WD?
	 JRST	%11.5		;FIELD NOT IN DESIRED SECTION.
	PAGE

;;;;;;;;;;;;  USER SPECIFIED A SPECIFIC FIELD NUMBER ;;;;;;;;;;;;;;;;

%11.7:
	SKIPE CURFLD			;IF FIELD ALREADY FOUND
	 JRST %11.15			;  THEN FINISH UP.
	MOVE	A,INT.A			;IF CURRENT FIELD IS 
	CAMLE	A,HIFLD			;  .GT. HIGHEST FIELD 
	 JRST	%11.14			;  THEN FINISH UP.

		;;GET POINTER TO CURRENT FIELD
	SOJ	A,		;CURFLD-1
	MOVEM	A,CURFLD
	CALL	GETNXT		;REALLY GET CURRENT FIELD
	 JRST	%11.14		;IF HERE, WE GOT TROUBLE
	 JRST	%11.16

	PAGE
;;;;;;;;;;;;;;;;;;;;;;;; USER SPECIFIED FIELD NAME ;;;;;;;;

%11.9:		;;SAVE FIELD IN 'INTBUF' WITH TRAILING NULL
	SKIPE CURFLD		;[67]IF CURRENT FIELD IS NOT 0,
	 JRST %11.13		;[67]  THEN WE HAVE BEEN HERE ALREADY.
	MOVE	B,INT.A
	MOVE	A,INT.B
	CALL FLDHSH		;[67]HASH THE NAME
	HLRZ A,FLDTAB(B)	;[67]GET THE STARTING FIELD
	JUMPE A,%11.13		;[73]IF NOTHING IN ENTRY, THEN ILLEGAL
	SOS A			;[67]  AND SET IT ONE BACK SO THAT
	MOVEM A,CURFLD		;[67]WE CAN START IN THIS POSITION.
	HRRZ A,FLDTAB(B)	;[67]GET THE LAST FIELD WITH THIS HASH
	MOVEM A,FLDTAB		;[67]  AND STORE IT INTO FLDTAB(0).

%11.10:	CALL	GETNXT		;SETUP THE NEXT FIELD.
	 JRST	%11.13			;NO MORE FIELDS.
	 JFCL				;GOT ONE
	MOVE A,CURFLD		;[67]IF THE CURRENT FIELD NUMBER
	CAMLE A,FLDTAB		;[67] IS ALREADY GREATER THAN THE LAST
	 JRST %11.13		;[67] POSSIBLE, THEN STOP LOOKING.
	LOAD	B,.FIELD,C	;CHECK THIS FIELD
	SUB B,V11SYM		;[35]OFFSET TO THE CORRECT
	ADD B,V12SYM		;[35] PAGE.
	HRLI	B,(POINT 7,0)
	MOVEI A,^D30		;[67]  AND THE LENGTH OF THE NAME TO 'A'.
	MOVEI D,(A)		;[67]USE SAME LENGTH HERE
	MOVE E,[POINT 7,INTBUF+8] ;[67]
	CALL MOV.7		;[67]MOVE THE STUFF TO INTBUF+8
	SETZB A,B		;[67]AND NOW FILL IT UP WITH 
	EXTEND A,[MOVSLJ	;[67] BLANKS
		  " "]		;[67]
	 JFCL
	DMOVE A,[^D30		;[67]PREPARE TO COMPARE
	         POINT 7,INTBUF];[67]  THE STUFF IN INTBUF
	DMOVE D,[^D30		;[67]WITH THE STUFF IN
		 POINT 7,INTBUF+8] ;[67] IN INTBUF+8
	EXTEND A,[CMPSE		;[67]
		  " "		;SPACE FILL BOTH
		  " "]		;  FIELDS
	 JRST %11.10		;FIELDS ARE NOT THE SAME
	 JRST %11.16		;FIELDS ARE THE SAME.
	PAGE
;;;;;;;;;;;;;;;;;;;; USER SPECIFIED A FORM ;;;;;;;;;;;;;;;;;;;;;

%11.12:
	CALL	GETNXT		;GET THE NEXT FIELD.
	 JRST	%11.13		;NO MORE.
	 JRST	%11.16		;GOT ONE.

;;;;;;;;;;;;;;;;;; COMMON EXIT ROUTINES USED BY ALL ;;;;;;;;;;;;;;;;;;

%11.13:			;;NO FIELD (DETERMINE IF 'NONE' OR 'NO MORE'.

	SETZM	SECTAB		;[67]INDICATE FINISHED WITH SECTION.
	SKIPE	FRSTFD		;IF THIS IS NOT THE FIRST FIELD
	 JRST	%11.15		;   THEN NO MORE FIELDS
	 JFCL			;   ELSE RETURN 'NO FIELD FOUND'.

%11.14:			;;NO FIELD WAS FOUND TO MATCH SPECIFICATION.

	SETZM	CURFLD		;DONE THIS PASS
	RET			;NON-SKIP

%11.15:			;;AT LEAST ONE FIELD WAS FOUND, BUT NONE ARE LEFT.
	SETZM	CURFLD		;DONE THIS PASS
	JRST SKPRT1		;RETURN TO  CALL + 2.

%11.16:			;;HERE WHEN FIELD HAS BEEN FOUND TO MATCH.
	LOAD	A,.LINE		;SETUP PARAMETERS FOR FIELD.
	LOAD	B,.COLM
	DMOVEM	A,LINFLD	;SET THE LINE AND COLUMN NUMBER.
	LOAD A,.FILLR		;SET UP THE FILLER CHARACTER
	ADDI A," "
	MOVEM A,FILCHAR
	LOAD	A,.LENG		;SET UP THE FIELD LENGTH.
	LOAD	B,.VALUE	;SET UP POINTER TO THE VALUE.
	SUB B,V11SYM		;[35]OFFSET TO THE CORRECT
	ADD B,V12SYM		;[35] PAGE.
	HRLI	B,(POINT 7,0)
	DMOVEM	A,LENFLD
	MOVEM	A,FULLEN	;SAVE FULL LENGTH OF FIELD
	LOAD	A,.OFFST
	IBP	A,RECPTR	;POINT TO REC IN W.S.
	MOVEM	A,OFFFLD
	JRST SKPRT2		;RETURN TO  CALL+3.
	SUBTTL	GETNXT - GET NEXT FIELD AND PUT DATA INTO WD1 - WD5
	LBL 12

COMMENT	+
	CALL GETNXT - NO ARGS
	 NO MORE FIELDS
	RETURN-OK CURFLD SETUP; WD1 - WD5 LOADED
	+


GETNXT:
	AOS	A,CURFLD	;BUMP FIELD COUNTER
	CAMLE	A,HIFLD		;IF FIELD # TOO LARGE
	 RET			;  THEN PROCESS IS DONE.

		;CALC POINTER TO DATA = DATA + (FLDLEN*(CURFLD-1)) 
	MOVE	B,CURFLD	;FORM FIELD-1
	SOJ	B,
	IMULI	B,FLDLEN	;TIME FLD LENGTH
;[35]	ADDI	B,DATA		;+ DATA = PTR TO FIELD
	ADD B,V12DAT		;[35] GET THE STARTING PAGE
	ADDI B,2		;[35]  AND THEN OFFSET IT.
	MOVEM	B,FLDPTR	;SAVE FOR STRPRM

	DMOVE	WD1,(B)		;LOAD WD1-WD5 WITH FIELD'S DATA.
	DMOVE	WD3,2(B)	;WD3 - WD4
	MOVE	WD5,4(B)	;WD5
	AOS	(P)
	RET


STRPRM:
		;;STORE THE FLAG REGISTER (PRM) BACK INTO THE
		;; FIELD AREA FOR SAVING BETWEEN CALLS

	SKIPE OLDPR		;[37]IF FIELDS ARE TO REMAIN
	 CALL STRP50		;[35]  THEN MAKE ALL TEMPORARY CHANGES
				;[35]       PERMINENT.
	MOVEM	PRM,@FLDPTR	;STORE PRM BACK IN DATA
	RET
STRP50:
	PUSH P,A		;[37]
	LDB A,[POINT 5,PRM,13]	;[37]  REQ,FULL,PROT,MSD,PREDUP
	DPB A,[POINT 5,PRM,23]	;[37]
	LDB A,[POINT 4,PRM,17]	;[37]  RANGU, RANGL, ALPHA,NUMER
	DPB A,[POINT 4,PRM,31]	;[37]
	POP P,A			;[37]
	RET			;[37]
	SUBTTL	WS2VAL - MOVE A FIELD'S VALUE FROM W.S. TO .VALUE

WS2VAL:
	MOVE	A,LENFLD		;LENGTH OF MOVE
	MOVE	D,A
	MOVE	B,OFFFLD	;FORM W.S. POINTER
	MOVE	E,VALFLD	;PTR TO CORE VALUE STORAGE
	EXTEND	A,[MOVSLJ]	;WILL NEVER NEED FILL CHARACTER !
	JFCL			;[21]
;[21]	RET			;IGNORE ERRORS
;[21] BEGIN EDIT WHICH FIXES NUMERICS AND BLANKS LEADING ZEROS

	TXNN PRM,NUMER%		;IF THIS IS NOT A NUMERIC
	 RET			; THEN RETURN
	TXNE PRM,%DATE+%SSN	;IF THIS IS A DATE OR SSN
	 RET			; THEN RETURN,

	MOVE A,LENFLD		;INDICATE THAT THE FIELD
	CALL SV.NUMRD		;  IS THE FULL LENGTH OF THE FIELD.
	MOVEI Z," "		;INDICATE BLANKING DESIRED
	SKIPE OLDZR		;[37]IF NOT BLANKING LEADING ZEROS
	 MOVEI Z,"0"		;[37]  THEN INDICATE THAT.
	TXNE PRM,%ZERBL		;[50]IF USING LEADING ZEROS
	 MOVEI Z,"0"		;[50]  THEN INDICATE THAT.
	CALL REPZER		;REPLACE ZEROS
	RET


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

REPZER:		;ROUTINE TO REPLACE LEADING ZEROS WITH BLANKS
		;AND PUT IN STANDARD NUMERIC FORM

	SETZM ISNEG		;INDICATE NUMBER NOT NEGATIVE.
	MOVE A,LENFLD		;GET LENGTH OF FIELD
	ADJBP A,VALFLD		;GET BYTE POINTER TO LAST CHAR.
	LDB B,A			;GET LAST CHARACTER OF FIELD
	MOVE C,CHRTAB(B)	; AND DETERMINE IF NUMERIC.
	TRNE C,NUMCHR		;IF IT IS NUMERIC
	 JRST WS2V50		;  THEN CONTINUE
	SUBI B,31		;IF NOT TURN IT INTO A NUMERIC.
	MOVE C,CHRTAB(B)	; OVERPUNCHED MINUS SIGN.
	TRNN C,NUMCHR		;IF NOT 1-9 THEN ASSUME AN
	 MOVEI B,"0"		; OVERPUNCHED ZERO.
	SETOM ISNEG		;IN ANY CASE, INDICATE NEGATIVE NUMBER.
	DPB B,A			;AND RESTORE THE NUMERIC VALUE.

WS2V50:

	MOVE A,LENFLD		; AND LENGTH OF FIELD.
	CAIE Z," "		;ARE WE BLANKING ?
	 JRST WS2V60		;NO..
	SUBI A,1		;DO NOT BLANK LAST ZERO IF ALL ZEROS
	TXNN PRM,%MONEY		;IF NOT A MONEY FIELD
	 JRST WS2V60		;   THEN SCAN ALL BUT LAST DIGIT.
	LDB B,.SUBTP		; OTHERWISE REMEMBER NOT TO BLANK
	SUBI A,(B)		; 0'S TO THE RIGHT OF THE DECIMAL.

WS2V60:  ;HERE WITH:
	 ; A -- MAXIMUM NUMBER OF CHARACTERS TO ATTEMPT TO BLANK.

	SETZ C,			;INITIALIZE NUMBER OF CHARACTERS BLANKED.
	MOVE D,VALFLD		;POINTER TO VALUE.
;[46]	JUMPE A,WS2V70		;BLANK NO DIGITS -- INSERT NO SIGN
	JUMPLE A,WS2V70		;BLANK NO DIGITS -- INSERT NO SIGN

WS2V62:  ;BLANKING LOOP
	ILDB B,D		;GET NEXT CHARACTER
	CAIN B,"0"		;IF LEADING 0
	 JRST WS2V65		; THEN CONTINUE BLANKING.
	CAIN B," "		;IF LEADING BLANK
	 JRST WS2V65		; THEN CONTINUE BLANKING.
	CAIN B,"+"		;IF LEADING PLUS SIGN
	 JRST WS2V65		; THEN CONTINUE BLANKING.
	CAIE B,"-"		;IF NOT LEADING MINUS
	 JRST WS2V70		;THEN SEARCH IS DONE.
	SETOM ISNEG		; OTHERWISE INDICATE NEGATIVE.
WS2V65: AOS C			;COUNT BLANKED DIGITS
	DPB Z,D			;INSERT THE BLANKING CHARACTER.
	SOJG A,WS2V62		;IF MORE CHARACTERS..LOOP.
	IBP D			;LEAVE BYTE POINTER IN GOOD STATE.

WS2V70:    ;HERE AFTER SEARCH FOR LEADING ZEROS IS DONE WITH:

		; C == NUMBER OF LEADING CHARACTERS BLANKED.
		; D == POINTING AT LAST CHARACTER BLANK.
		; ISNEG = 0 IF POSITIVE, -1 IF NEGATIVE.
	SKIPE C			;IF NO CHARACTERS BLANKED
	 SKIPL ISNEG		;  OR A POSITIVE NUMBER
	  JRST WS2V80		; THEN JUST LEAVE IT AS IS.
	MOVEI A,"-"		; ELSE INSERT THE MINUS SIGN.
	CAIE Z," "		;IF NOT BLANKING
	 JRST [MOVE D,VALFLD	;  THEN PUT SIGN IN THE
	       IDPB A,D		;   FIRST POSITION.
	       RET]
	SETO B,			;BACKUP THE POINTER BY 1
	ADJBP B,D		; BYTE
	DPB A,B			;  AND DEPOSIT THE MINUS SIGN.

WS2V80:	;HERE WHEN THE NUMBER IS PROPERLY BLANKED IN THE VALUE AREA.
	RET
;[21] END OF BLANKING AND MINUS PATCH.
	SUBTTL	SUBFLD - GET THE NEXT SUB-FIELD POSITION & LENGTH

;	CALL SUBFLD (SUBX, SUBY, SUBTAB, PRM, .LINE, .COLM)
;	 <NO-MORE> THIS FIELD
;	RETURN (A=LINE; B=COLM; C=LENGTH)

SUBFLD:
	SKIPL	SUBX		;IF -1, DO INITIALIZATION
	 JRST	$SF.1		;ELSE GO CALC STUFF  RETURN
	SETZM	SUBY		;START FRESH
	SETZM	SUBP		;NO PRIOR DISPLACEMENT
	CALL	SAVCPM		;SAVE CURRENT STATUS
	MOVE	D,LENFLD	;REMEMBER IN CASE OF MONEY FIELD
	SETZM	LENFLD		;NO PREVIOUS LENGTH ON FIRST SUB-FIELD
	TXNN	PRM,%DATE	;A DATE FIELD
	 JRST	$SF.2
	LDB	A,.SUBTP	;GET TYPE OF DATE FIELD.
	CAIN	A,5		;[102] IF THIS IS THE CANDIAN DATE
	 SETZ A,		;[102]	  THEN TREAT AS SLASH
	CAIL	A,3
	 TRZ	A,6		;3=1 4=0
	JRST	$SF.0		;GO SAVE SUBX NUMBER

$SF.2:	TXNN	PRM,%MONEY	;MONEY ?
	 JRST	$SF.3
	MOVEI	A,4
	LDB	B,.SUBTP
	DPB	B,[POINT 7,SUBTAB+4,13] ;CENTS
	MOVE	C,D
	SUB	C,B
	DPB	C,[POINT 7,SUBTAB+4,6]
	JRST	$SF.0

$SF.3:	TXNN	PRM,%SSN
	 RET
	MOVEI	A,3		;SSN FIELDS
$SF.0:	MOVEM	A,SUBX
$SF.1:	MOVE	A,SUBY
	IBP	A,[POINT 7,SUBTAB,6] ;FORM PTR TO ENTRY
	ADD	A,SUBX		;CORRECT TABLE DISPLACEMENT
	LDB	C,A		;C=LENGTH OF SUB FIELD
	CAME	A,[POINT 7,SUBTAB+4,6] ;FIRST MONEY ENTRY MAY BE 0
	 JUMPE	C,$SF.4		;0=DONE (IF NOT DOLLARS)
	DMOVE	A,LINFLD	;GET LINE AND COL NUMBER.
	ADD	B,SUBP		;FORM CORRECT DISPLACEMENT
	MOVE	D,LENFLD		;FORM OFFSET TO VALUE FIELD
	ADJBP	D,VALFLD
	MOVEM	D,VALFLD
	MOVEM	C,SUBP		;SAVE DISPLACEMENT FOR NEXT TIME
	AOS	SUBP
	DMOVEM	A,LINFLD	;SAVE NEW POSITION
	MOVEM	C,LENFLD	;SAVE LENGTH
	AOS	SUBY
	JRST SKPRT1		;SKIP RETURN
$SF.4:	SETOM	SUBX
	CALL	RSTCPM		;RESTORE STATE OF WORLD
	RET
	SUBTTL	STRING MOVERS & TRANSLATERS

MOV6OR7:		;MOVE EITHER SIXBIT OR SEVEN BIT
			;ON ENTRY:
			;  A-- LENGTH OF MOVE 'FROM' FIELD
			;  B-- BYTE POINTER FOR 'TO FIELD.
			;  D-- LENGTH OF MOVE 'TO' FIELD
			;  E-- BYTE POINTER FOR 'TO FIELD.

	TLNN B,100	;IF NOT ASCII TO ASCII
	 JRST [CALL MOV.6	;ASSUME SIXBIT TO ASCII
	       RET]		;AND RETURN
	CALL MOV.7		;ELSE DO ASCII MOVE
	RET			;AND RETURN

MOV.6:
	TLO A,400000		;INDICATE STOP ON SPACE & NULLS
	EXTEND	A,[MOVST SIX27
			 " "]	;SIXBIT TO 7BIT
	 SETZ	A,		;ABORT = ALL SOURCE BYTES DONE
	RET
MOV.7:
	TLO A,400000		;INDICATE STOP ON SPACE & NULLS
	EXTEND	A,[MOVST SVN27
			 " "]	;ASCII TO ASCII
	 SETZ	A,		;ABORT = ALL SOURCE BYTES DONE
	RET

INT627:				;SIXBIT TO ASCII IN INTBUF
	PUSH	P,A		;PRESERVE A
	DMOVE	D,[130		;INTBUF LENGTH
		   POINT 7,INTBUF]
	CALL	MOV.6		;MOVE 6 TO ASCII
	SETZB A,B		;AND NOW FILL OUT THE
	EXTEND A,[MOVSLJ	; OF INTBUF WITH
		  " "]		;  SPACES
	 JFCL
	MOVE	B,[POINT 7,INTBUF]
	POP	P,A
	RET

;**; [120] INSERT AFTER END OF IN627 ROUTINE	CLRH	26-FEB-80
INT72U:				;[120] ASCII TO UPPERCASE ASCII IN INTBUF
	PUSH	P,A		;[120] PRESERVE A
	DMOVE	D,[130		;[120] LENGTH OF INTBUF
		   POINT 7,INTBUF]	;[120] POINTER TO INTBUF
	TLO	A,400000	;[120] START SIGNIFICANCE
	EXTEND	A,[MOVST SVN2U	;[120] MOVE TRANSLATED
		   " "]		;[120] BLANK FILL
	 SETZ	A,		;[120] (IF NECESSARY)
	MOVE	B,[POINT 7,INTBUF]	;[120] SET UP POINTER IN B
	POP	P,A		;[120] RESTORE A
	RET

	PAGE
TRNCBL:		;ROUTINE TO GIVE NUMBER OF SIGNIFICANT CHARACTERS
		;ON A LINE BY 'TRUNCATING' TRAILING BLANKS.

		;ENTER WITH A--POINTER TO FIELD, B--LENGTH OF FIELD
		;EXIT WITH A--POINT TO LAST SIGNIFICANT CHAR, B=COUNT

	MOVEI C,(B)		;GET LENGTH OF STRING IN C
	ADJBP C,A		;AND POINT TO END OF STRING
	MOVE A,C		; AND PUT POINTER IN A.

TRNC10:
	LDB D,C			;GET CHARACTER
	CAIE D," "		;IF IT IS A NOT A BLANK THEN
	 RET			;  RETURN WITH NUMBER IN 'B'.
	HRROI C,-1		;  ELSE BACKUP THE POINTER
	ADJBP C,A		;  ONE.
	MOVE A,C		;MOVE THE POINTER BACK.
	SOJG B,TRNC10		;AND BACKUP.
	RET			;IF NO SIGNIFICANT CHARS, STOP.
	SUBTTL	TFRWRT - WRITE TO SCREEN
	LBL 5

COMMENT	+
	CALL TFRWRT (FIELD-ID, ERR)
	RETURN      (ERR)
	+


TFRWRT:
ENTER	FRMWRT,2		;[7]
	SETZM @1(ARG)		;[17]INDICATE NO ERROR.
	MOVEI	INT.A,@0(ARG)	;GET W.S. POINTER
	HRRZ	INT.B,1(INT.A)
	MOVE	INT.A,0(INT.A)
	CALL $SBEGIN		;[64]INITIALIZE OUTPUT BUFFER

%5.1:
	CALL	FIND		;GET THE NEXT FIELD
	 JRST	%5.4		;NO FIELDS FOUND WITH SPECIFICATION.
	 JRST	%5.3		;NO MORE FIELDS FOUND.
	 JFCL			;FIELD FOUND.

	CALL WRTDSP		;[60]IF FIELD NOT DISPLAYED AND NOT
	 JRST %5.5		;[60]  NOT INITIALIZING NEW FIELDS..DO THIS.
	CALL	WS2VAL		;MOVE WORKING STORAGE TO VALUE.

	;SET #RD TO LENGTH OF FIELD MINUS TRAIL SPACES
	MOVE	A,VALFLD	;PTR TO CORE VALUE STORAGE
	MOVE	B,LENFLD		;LENGTH OF FIELD
	CALL TRNCBL		;COUNT SIGNIFICANT DIGITS
	MOVEI A,(B)		;RETURNING WITH COUNT IN 'B'.
	CALL	SV.NUMRD
	CALL	WRITE		;WRITE THE CURRENT FIELD.
	TXON PRM,%DSPLY		;[60]IF FIELD WAS NOT DISPLAY, THEN
	 CALL FILL		;[60]  APPLY FILLERS TO END OF LINE.
	TXNE	PRM,MSDUP%	;[45]IF THE FIELD IS MASTER DUPE
	 TXO PRM,PRDUP%		;[45] THEN SET MASTER DUPE FLAG.
	CALL STRPRM		;SAVE THE 'PRM' INFORMATION.
	CALL $SCHKPNT		;[64]FLUSH OUTPUT BUFFER IF ROOM NEEDED.
	JRST %5.1		;DO IT AGAIN

%5.3:		;RETURN TO USER,... NO MORE FIELDS
;[17]	SETZM	@1(ARG)
	CALL $SEND		;[64]SEND OUTPUT BUFFER.
	RET

%5.4:	MOVEI A,ERR.NF		;INDICATE FIELD NOT FOUND ERROR.
	MOVEM	A,@1(ARG)
	RET

%5.5:	MOVEI A,ERR.ND		;INDICATE FIELD NOT DISPLAYED ERROR.
	MOVEM	A,@1(ARG)
;[17]	CALL $SEND		;[65] SEND OUT THE BUFFER
;[17]	RET
	JRST %5.1		;[17]CONTINUE AROUND.

;[60] BEGIN PATCH





WRTDSP:		;ROUTINE TO TEST DISPLAY BIT, AND DETERMINE IF 
		;UNDISPLAYED FIELDS ARE TO BE INITIALIZED ANYWAY.
	TXNE PRM,%DSPLY		;[60]IF THIS FIELD IS DISPLAYED
	 JRST [CALL BLANK	;[60] THEN BLANK IT AND
		JRST SKPRET]	;[60]  RETURN.
	SKIPE OLDWR		;[60] ELSE IF NOT INITIALIZING DURING WRITE
	 RET			;[60]   THEN ERROR RETURN.
	CALL GETPRM		;[60]INITIALIZING NONDISPLAYED FIELD SO
	CALL STRPRM		;[60] PRM VALUES MUST BE SET UP.
	MOVEI A,ERR.ND		;[60]INFORM USER THAT AT LEAST ONE
	MOVEM A,@1(ARG)		;[60]  FIELD IS NOT DISPLAYED.
	JRST SKPRET		;[60] AND RETURN
	SUBTTL	FILL & BLANK - FILL OR BLANK A FIELD WITH FILL

FILL:
	TXNE	PRM,%DATE!%SSN!%MONEY ;SPECIAL
	 JRST	SF1		;DO SUBFIELDS
	MOVE 0,FILCHAR		;GET THE FILLER AND
	CAIN 0," "		;IF FILLER IS A BLANK
	 RET			;  THEN DON'T BOTHER FILLING.
SF1:
	CALL LD.NUMRD		;GET NUMBER OF CHARS IN FIELD.
	MOVEI C,(A)		;  AND MOVE THEM TO 'C'
	DMOVE A,LINFLD		;GET LINE AND COLUMN IN A&B
	TXNN	PRM,PROT%		;[11]IF FIELD IS UNPROTECTED
	 TXNE	PRM,%DSPLY		;[11] AND CURRENTLY NOT ON SCREEN
	  SKIPA				;[11]  THEN
	  SETZ  C,			;[11]   FILL THE WHOLE FIELD.
	MOVE	D,LENFLD
	MOVEM D,YET2WT			;SAVE TOTAL # IN FIELD.
	SUB	D,C		;NUM REMAINING IN FIELD
	SKIPG	D		;ANY?
	 RET			;NO
	ADD	B,C		;START + NUM RD
	TXNN	PRM,%DATE!%SSN!%MONEY ;SPECIAL
	 JRST [CALL $POSIT	;POSITION TO FIELD
	       PJRST COMFIL]	; AND FILL IT OUT.
	MOVEM	D,NUMREM	;SAVE NUMBER REMAINING UNFILLED

FILOOP:
	CALL	SUBFLD
	 JRST	RSTRET
	MOVN D,C		;THIS MUCH IS LEFT AND SO
	ADDB D,YET2WT		;UPDATE BOTH.
	CAML	D,NUMREM	;TOO FAR YET?
	 JRST	FILOOP		;NO
	MOVE	D,NUMREM
	SUB	D,YET2WT
	ADD	B,C		;COL+LENG
	SUB	B,D		;   -#THIS WRITE
	MOVN	E,D		;THIS MUCH LESS
	ADDM	E,NUMREM
	CAME	D,C		;FULL SUBFIELD ?
	 JRST	JUSTFL		;NO - JUST FILL
	MOVE	E,SUBY		;SEE IF ON FIRST SUB-FIELD
	SOJE	E,JUSTFL		;JUMP IF FIRST
	SOS B			;BACKUP COLUMN POSITION
	CALL $POSIT		; AND POSITION CURSOR
	CALL SEPCHR		; PRINT SEPARATOR
	CALL COMFIL		; AND FILL IN.
	JRST FILOOP		;NEXT SUBFIELD.

JUSTFL:
	JUMPLE D,FILOOP		;DO NOTHING IF NOTHING
	CALL $POSIT		;POSITION TO SUBFIELD
	CALL	COMFIL
	JRST	FILOOP

COMFIL:
	PUSH P,C		;[64]USE 'C' FOR THE
	MOVE C,D		;[64] FOR THE CHARACTER COUNT
	MOVE A,FILCHAR		;GET THE FILLER CHARACTER.
	CALL $SMCHAR		;[64]SEND OUT 'A' MULTIPLE TIMES
	POP P,C			;[64]RESTORE 'C'.
	RET

ABLANK:
	MOVE	C,LENFLD
	MOVEI	A," "
	MOVEM	A,FILCHAR	;SAVE FILL CHAR FOR A WHILE
	DMOVE	A,LINFLD
	TXNE	PRM,%SSN
	 ADDI	C,2
	TXNE	PRM,%MONEY
	 AOJ	C,
	TXNN	PRM,%DATE
	 JRST	COMBLK
	TXNN	PRM,%DATDE!%DATSL
	 TXNN	PRM,%DATJU
	  ADDI	C,2
	JRST	COMBLK

BLANK:
	CALL LD.NUMRD			;LOAD NUMBER OF CHARS IN FIELD
	MOVEI C,(A)			 ; AND MOVE THEM TO 'C'
	TXNN	PRM,PROT%		;[11]IF FIELD IS UNPROTECTED
	 TXNE	PRM,%DSPLY		;[11] AND CURRENTLY NOT ON SCREEN
	  SKIPA				;[11]  THEN
	  MOVE  C,LENFLD		;[11]   FILL THE WHOLE FIELD.
	SKIPN	C
	 RET
	DMOVE	A,LINFLD
	TXNN	PRM,%DATE!%SSN!%MONEY ;SPECIAL?
	 JRST	COMBLK		;NO
	MOVEM	C,YET2WT
	SETOM	SUBX		;[4] INDICATE START OF SPECIAL FLD
BKLOOP:
	CALL	SUBFLD		;GET A SUBFLD
	JRST	RSTRET
	JUMPE	C,BKLOOP	;IGNORE NULL FIELDS

	CAMLE	C,YET2WT	;LESS LEFT TO WRITE THAN WE HAVE ?
	 MOVE	C,YET2WT	;YES - USE MOST RESTRICTIVE CASE
	JUMPLE	C,RSTRET	;RESTORE THE WORLD IF NO MORE
	MOVN	D,C		;DECR. COUNTER
	ADDM	D,YET2WT
	CALL	COMBLK		;DO SOME BLANKING
	JRST	BKLOOP		;& LOOP 'TILL DONE.

COMBLK:
	CALL	$POSIT
	MOVE	A,FILCHAR
	CALL $SMCHAR		;[64]SEND 'A'   'C' TIMES
	RET

SEPCHR:				;PICK A SEPR. CHAR. & OUTPUT IT.
	PUSH	P,A
	PUSH	P,B
	TXNE	PRM,%MONEY
	 MOVEI	A,"."
	TXNE	PRM,%SSN
	 MOVEI	A,"-"
	TXNN	PRM,%DATE
	 JRST	SEPOUT
	MOVEI	A,"-"
	LDB	B,.SUBTP
	CAIE B,%DATCA		;[102]IF THIS IS EITHER CANADIAN
	  CAIN	B,%DATSL	;	  OR SLASH THEN
	   MOVEI	A,"/"	;		SET A SLASH.
SEPOUT:
	CALL $SCHAR		;[64]SEND THE SINGLE CHAR IN 'A'.
	POP	P,B
	POP	P,A
	RET
	SUBTTL	TFRRD  - READ A FIELD-ID FROM SCREEN
	LBL 6

COMMENT	+
	CALL TFRRD (FIELD-ID, END-CHAR, ERR)
	RETURN (END-CHAR, ERR)
	+


TFRRD:
ENTER	FRMRD,3			;[7]
	SETZM @2(ARG)		;[17]INITIALIZE ERROR RETURN.
	CALL $SBEGIN		;[64]INITIALIZE THE OUTPUT LINE
	SETZM MAXFLD		;[71]INDICATE NOT BACKING UP.

%6.1:	MOVEI	INT.A,@0(ARG)	;GET W.S. POINTER
	HRRZ	INT.B,1(INT.A)
	MOVE	INT.A,0(INT.A)
	CALL	INITSD
	 JRST	%6.14		;INIT FAILED = NOT FOUND
	 JFCL			;FIELD WAS FOUND
	SETZM	DEFALT		;INDICATE NOT DEFAULTING FIELDS

%6.4:
	CALL	FIND		;GET NEXT FIELD SPECIFIED
  	 JRST	%6.14		;NO FIELD WAS FOUND.
	 JRST	%6.15		;NO MORE FIELD ANSWER SPECIFICATION.
	 JFCL			;A FIELD WAS FOUND.

	TXNN PRM,%DSPLY		;[17]ON THE SCREEN ?
	 JRST [MOVEI A,ERR.ND	;INDICATE NOT DISPLAYED
	       MOVEM A,@2(ARG)  ;[17]  ON RETURN
	       JRST %6.4]	;[17]AND GO FOR NEXT FIELD

	TXNE	PRM,PROT%	;IF FIELD IS PROTECTED
	 JRST	%6.4		;  THEN BYPASS IT.

	MOVN INT.C,PRM		;IF BOTH MSDUP% AND PRDUP% ARE ON
	TXNN	INT.C,MSDUP%+PRDUP% ;  THEN FIELD IS MASTER DUPED
	 JRST %6.4		;        AND SHOULD BY BYPASSED.

;**; [121] INSERT AT %6.4 + 12 1/2	CLRH	26-FEB-80
	SETZM	TXTTAB+.RDDBC	;[121] CLEAR DESTINATION BYTE COUNT
	SETZM PREDUP		;[15]INDICATE NOT PREVIOUS DUPE
	MOVE A,MAXFLD		;[71]IF WE WERE BACKING UP BUT HAVE
	CAMG A,CURFLD		;[71]  NOW COME BACK TO THE STARTING POINT
	 SETZM MAXFLD		;[71]  OF THE BACKUP, RESET.
	SKIPE MAXFLD		;[71]IF WE ARE BACKING UP THEN
	 SETOM PREDUP		;[71]INDICATE FIELD IS PREVIOUS DUPE.

	TXNE PRM,MSDUP%		;IF MASTER DUPE BUT NOT VALUE
	 JRST %6.7		; THEN TREAT LIKE NORMAL.

	TXNN PRM,PRDUP%		;IF NOT PREVIOUS DUPE THEN
	 JRST [SKIPN MAXFLD	;[71]IF NOT BACKING UP
		JRST %6.7	;[71]  THEN IT IS NOT PREVIOUS DUPE
		JRST .+1]	;[71]  ELSE TREAT AS PREVIOUS DUPE.

	SETOM	PREDUP		;[15] INDICATE PREVIOUS DUP
	SKIPN DEFALT		;IF READING ALL FIELDS THEN
	 JRST	%6.8		;  THEN GO TO READ
	CALL LD.NUMRD		;  ELSE GET CURRENT SIZE AND
	MOVE INT.C,A
	JRST %6.10		;AND MERELY CHECK REQUIRED STATUS.

%6.7:
	SKIPN DEFALT		;IF READING ALL FIELDS 
	 JRST %6.8		;  THEN GO TO READ ROUTINE
	SETZB A,INT.C		;  ELSE SET SIZE TO ZERO AND
	JRST %6.10		;    GO CHECK FOR REQUIRED STATUS.

;;;;;;;; READ THE SPECIFIED FIELD ;;;;;;

%6.8:
	CALL FLDRD		;  AND THEN READ THE FIELD.
	JUMPN	B,%6.ESC	;ESCAPE WAS RETURNED FROM INTRD.

%6.9:	SKIPN OLDMD		;[37]IF MASTER DUPE IS NOT TO BE TURNED
	 JRST %6.10		;[37] ON UNLESS CHARACTERS TYPED..GO ON.
	TXNE	PRM,MSDUP%	;[37]ELSE ;IF MASTER DUPE AND
	 TXNE	PRM,PRDUP%	;[37]  NOT ON THE SCREEN
	  JRST	%6.10		;[37]   THEN
	TXO PRM,PRDUP%		;[37]      INDICATE THAT IT HAS VALUE.
	CALL STRPRM		;[37]	AND
	JRST %6.10		;[37]	  THEN CONTINUE.

%6.10:
	CALL	CKREQD		;CHECK REQUIRED ATTRIBUTE
	 JRST	[HRROI C,MSG.RQ ;REQUIRED ERROR
		 CALL  INTERR
		 JRST  %6.8]	;GO FOR IT AGAIN

	SKIPGE DEFALT		;[14]IF ONLY CHECKING REQUIRED STATUS
	 JRST %6.4		;[14] THEN GO ON TO NEXT FIELD.

	JUMPE A,%6.4		;IF NOTHING TYPED, NO FURTHUR PROCESSING.
	SKIPN NEWDAT		;IF NOT NEW DATA (PREVIOUS DUPE)
	 JRST %6.4		;  THEN ALL IS OK.
	CALL	REFORM		;SKIPS IF FIELD ON SCREEN IS CORRECT
	 CALL REWRITE		;[51]REWRITE FIELD IF DESIRABLE.
	SKIPLE DEFALT		;[33]IF WE JUST STARTED DEFAULTING
	 SETOM DEFALT		;[33]  THEN INDICATE NO MORE WRITING.

	TXNE	PRM,MSDUP%	;IF MASTER DUPE AND
	 TXNE	PRM,PRDUP%	;  NOT ON THE SCREEN
	  JRST	%6.11		;   THEN
	TXO PRM,PRDUP%		;      INDICATE THAT IT HAS VALUE.
	CALL STRPRM		;	AND CONTINUE

;;;;;;;;;;;;;;;;;;;; CHECK THE FIELD FOR LEGALITY ;;;;;;;;;;;;;;;

%6.11:

	TXNN	PRM,%DATE	;[16]DATE CHECK REQUIRED
	 JRST %6.11B		;[16] NOT A DATE.. CONTINUE
	CALL	CKDATE		;[16] DATE CHECKING
	 JRST	[HRROI C,MSG.ID	;[16] ILLEGAL DATE
		 CALL  INTERR	;[16]
		 JRST  %6.13]	;[16]

%6.11B:				;[16]JUMP HERE IF NOT DATE
	TXNN PRM,%RANGU%+RANGL%	;[110]IF NO RANGE CHECKS
	 JRST %6.4		;[110]  THEN ALL IS OK

	PUSH P,VALFLD		;[110] MOVE THE VALUE INTO A FIELD
	MOVE A,INTBUF		;[110]  WITH LEADING ZEROS IF NUMERIC
	MOVE A,[POINT 7,INTBUF] ;[110]  WITH LEADING ZEROS IF NUMERIC
	MOVEM A,VALFLD		;[110]
	PUSH P,OLDZR		;[110]  SAVE BLANKING INDICATOR
	SETOM OLDZR		;[110] INDICATE LEADING ZEROS
	CALL WS2VAL		;[110] MOVE IT.
	POP P,OLDZR		;[110] RESTORE THE VALUE
	POP P,VALFLD		;[110] AND THE POINTER

	CALL	CKRGLW
	 JRST	[LOAD B,.LRANG,A	;NOT WITHIN RANGE.
		 SUB B,V11SYM	;[35]OFFSET TO THE CORRECT
		 ADD B,V12SYM	;[35] PAGE.
		 HRLI B,(POINT 7,0)
		 MOVEM	B,ERRRNG
		 HRROI C,MSG.LR
		 CALL INTERR
		 JRST %6.13]
	CALL	CKRGUP
	 JRST	[LOAD B,.URANG,A	;NOT WITHIN RANGE
		 SUB B,V11SYM	;[35]OFFSET TO THE CORRECT
		 ADD B,V12SYM	;[35] PAGE.
		 HRLI B,(POINT 7,0)
		 MOVEM B,ERRRNG
		 HRROI C,MSG.UR
		 CALL INTERR
		 JRST %6.13]
	JRST	%6.4		;ALL OK


%6.13:		;;ERROR (NOT WITHIN RANGE, ILLEGAL DATE) DISCOVERED.
	CALL INTCFD		;RE-INITIALIZE THE FIELD.
	JRST %6.8		;REREAD THE FIELD.


%6.14:	MOVEI INT.C,ERR.NF		;FLAG FIELD NOT FOUND ERROR.
	MOVEM	INT.C,@2(ARG)
	SETZM	@1(ARG)		;ERROR GIVES OK TERM CHAR
	RET			;RETURN

%6.15:		;;NORMAL RETURN
;[17]	SETZM	@2(ARG)
	CALL $SEND		;[64]FLUSH ANY OUTPUT
	MOVE	A,TRMCHR	;SET TERMINATOR
	MOVEM	A,@1(ARG)
	RET			;RETURN


CKREQD:				;CHECK REQUIRED ATTRIBUTE

	SKIPE A		;IF SOMETHING WAS ENTERED
	  SKIPA		;  THEN GIVE GOOD (SKIP) RETURN
	TXNN PRM,REQD%	;IF NOTHING ENTERED BUT FIELD OPTIONAL
	  AOS (P)	;  THEN GIVE GOOD RETURN
	  RET		;  ELSE GIVE BAD (NOSKIP)RETURN.


;[51]TEST IF FIELD SHOULD REALLY BE REWRITTEN TO THE SCREEN.

REWRITE:
	SKIPN OLDRN		;IF REWRITING NUMBERS
	 CALL WRITE		;THEN DO IT.
	RET			;ELSE RETURN
;[51]END OF ADDITION

;*************** HANDLE THE ESCAPE SEQUENCES ****************

%6.ESC:	PUSH P,A		;[71]SAVE THE CHARACTER COUNT OF FIELD.
	CALL	SV.NUMRD		;SAVE COUNT OF # RD SO FAR
	CALL INICUF		;[24]INITIALIZE CURRENT FIELD.
	POP P,A			;[71]RESTORE CHARACTER COUNT TO 'A'.
	JRST	.(B)		;B=1 THRU 3
	JRST	ESC.P		;(BLUE) BACKUP TO BEGINNING OF FIELD.
	JRST	ESC.Q		;(RED)  BACKUP TO BEGINNING OF READ.
	JRST	ESC.R		;(BLACK)REWRITE SCREEN.

ESC.P:
	TXNE PRM,PRDUP%		;[71]IF THIS IS A PREVIOUS DUPE FIELD
	 JRST [SKIPL PREDUP	;[71]  THEN IF SOME CHARACTERS WERE TYPED
	        JRST [SETOM PREDUP	;[71] THEN RAISE THE PREV-DUPE FLAG
		     JRST  %6.7]	;[71]      AND REREAD THE FIELD.
		JRST ESC.P1]	;[71]          ELSE FIND PREVIOUS FIELD
				;[71]  ELSE NEXT STATEMENT.
	SKIPN MAXFLD		;[71]IF NOT BACKING UP
	 JRST [JUMPG A,%6.7	;[71]  THEN IF ERASE CURRENT FIELD, DO IT
	       JRST ESC.P1]	;[71]           ELSE BACKUP ONE FIELD.
	SKIPL PREDUP		;[71]  ELSE IF SOME CHARACTERS WERE TYPED
	 JRST [SETOM PREDUP	;[71]        THEN RAISE THE PREV-DUPE FLAG
	       JRST %6.7]	;[71]			AND REREAD FIELD.
	JRST ESC.P1		;[71]	ELSE BACKUP ONE FIELD.

ESC.P1:	MOVE A,CURFLD		;[71]  BACKUP TO PREVIOUS FIELD.
	SKIPN MAXFLD		;[71]IF NOT CURRENTLY BACKING UP,
	 MOVEM A,MAXFLD		;[71]  THEN START BACKUP HERE.
	PUSH P,A		;[71]SAVE THE CURRENT FIELD NUMBER.
	SETZM CURFLD		;[71]PREPARE TO FIND PREVIOUS FIELD
	SETZM SECTAB		;[71] BY STARTING AT BEGINNING OF
	SETZM LASTFLD		;[71] THE READ AND SAVING THE PREVIOUS 
				;[71] FIELD NUMBER.
ESC.PA:
	CALL FIND		;[71]FIND THE NEXT FIELD
	 JFCL			;[71] WE SHOULD NOT GET THESE
	 JFCL			;[71] THESE RETURNS.
	 JFCL			;[71]
	TXNN PRM,%DSPLY		;[71]IF FIELD NOT DISPLAYED, THEN 
	 JRST ESC.PA		;[71] IT IS NOT OF INTEREST.
	TXNE PRM,PROT%		;[71]IF FIELD IS PROTECTED, THEN IT
	 JRST ESC.PA		;[71] IS NOT OF INTEREST EITHER.
	MOVN INT.C,PRM		;[71]IF FIELD IS SET-MASTER DUPE
	TXNN INT.C,MSDUP%+PRDUP%;[71] THEN IT IS NOT OF INTEREST.
	 JRST ESC.PA		;[71]
	MOVE A, CURFLD		;[71]IF THIS FIELD'S NUMBER IS
	CAMN A,(P)		;[71] IS THE SAME AS THE CURRENT ONE
	 JRST ESC.PB		;[71] THEN LASTFLD WILL HAVE PREVIOUS ONE
	MOVEM A,LASTFLD		;[71]ELSE SAVE THIS FIELD AS PREVIOUS FIELD.
	JRST ESC.PA		;[71] AND CONTINUE SEARCHING FOR CURRENT.

ESC.PB:
	POP P,0			;[71]RESTORE THE STACK.
	SKIPN A,LASTFLD		;[71]IF LAST FIELD IS STILL ZERO THEN
	 JRST %6.7		;[71] THEN WE CANNOT BACKUP FARTHER.
	SOS A			;[71] ELSE USE THIS AS NEXT FIELD
	MOVEM A,CURFLD		;[71] TO READ
	JRST %6.4		;[71] GO GET IT.

ESC.Q:
	MOVE A,CURFLD			;[71]SAVE CURRENT FIELD #
	SETZM	CURFLD
	SETZM SECTAB			;[67]INITIALIZE SECTION TABLE
	SKIPN MAXFLD			;[71]IF NOT IN BACKUP YET
	 MOVEM A,MAXFLD			;[71]  THEN INDICATE WE ARE.
	JRST	%6.4		;RESTART CURRENT READ

ESC.R:				;RE FORMAT SCREEN
	PUSH	P,INT.A		;SAVE SOME STUFF
	PUSH P,SECTAB		;[67]SAVE THE SECTION INITIALIZATION
	PUSH	P,CURFLD
	SETZB	INT.A,CURFLD
	CALL	$CLEAR		;CLEAR ALL OF SCREEN
ESC.RF:				;ESC.R LOOP
	CALL	FIND
	 JRST ESC.RG		;NOT-FOUND.
	 JRST ESC.RG		;[24] RESTORE REGISTERS.
	 JFCL			;[24]FOUND IT.

	TXNN	PRM,%DSPLY	;DO THOSE PREVIOUSLY ON SCREEN
	 JRST	ESC.RF
	CALL	WRITE
	CALL	FILL
	CALL $SCHKPNT		;[64]FLUSH BUFFER IF NECESSARY
	JRST	ESC.RF

;[24] START OF PATCH TO FIX UP ESCAPE SEQUENCES

ESC.RG:
	MOVE INT.A,0(P)		;RESTORE CURRENT FIELD.
	SETZM CURFLD
	CALL INITSD		;MAKE SURE WE POINT AT IT.
	 JFCL
ESC.RH:	POP P,CURFLD
	POP P,SECTAB		;[67]RESTORE SECTION TABLE STUFF
	POP P,INT.A
	JRST %6.7




INICUF:		;INITIALIZE CUFRENT FIELD BEFORE HANDLING THE
		; ESCAPE SEQUENCE.

	PUSH P,B		;SAVE ESCAPE TYPE.
	PUSH P,INT.A		; AS WELL AS THE FIELD NUMBER
	PUSH P,CURFLD
	SKIPE MAXFLD		;[71]IF BACKING UP FIELDS
	 JRST INIC50		;[71] THEN TREAT LIKE PREVIOUS DUPE.
	TXNE PRM,PRDUP%		;IF THIS IS A PREVIOUS DUPE FIELD
	 JRST INIC50		;  THEN HANDLE IT DIFFERENTLY.
	MOVE INT.A,CURFLD	;RE-INITIALIZE FILLERS
	SETZM CURFLD
	CALL INITSD		;  BY CALLING INTERNAL INITIALIZATION.
	 JFCL			;SHOULD NOT HAPPEN.
INIC10:				;COMMON EXIT.
	POP P,CURFLD		;RESTORE THE FIELD INDICATORS
	POP P,INT.A
	POP P,B			;  AND THE ESCAPE TYPE.
	RET

INIC50:		;HANDLE THE PREVIOUS DUPE FIELD.
	SKIPE PREDUP		;IF FIRST CHAR OF PRE-DUP NOT TYPED
	 JRST INIC10		;  THEN FIELD IS STILL ON SCREEN
	CALL FORMAT		;ELSE RESET WITH
	CALL WS2VAL		;  THE FILLERS.
	CALL BLANK		;  WITH FILLERS.
	SETZ A,			;AND RESET THE COUNT
	CALL SV.NUMRD
	CALL $SCHKPNT		;[64]SEND OUT BUFFER IF NECESSARY.
	JRST INIC10

;[24] END OF CODE TO FIX UP THE ESCAPE SEQUENCES
;***************** END OF ESCAPE HANDLING ****************
	SUBTTL	REFORM - REFORMAT VALUE => W.S. => VALUE
	LBL 14

REFORM:
;[20]	MOVE	VALFLD
;[20]	ILDB	E,0
;[20]	CAIN	E,11
;[20]	TXNN	PRM,PRDUP%
;[20]	JRST	.+2
	SKIPE ISTAB		;[20]IF PREVIOUS DUPE TABBED OVER
	 JRST	SKPRET		;[20]  THEN IS IN GOOD FORM.
	TXNE	PRM,NUMER%	;NUMERIC
	 JRST	%14.2		;YES - NEEDS SPECIAL CARE
	CALL	SV.NUMRD		;SAVE NUMBER OF BYTES READ
	MOVE B,VALFLD
	MOVE E,OFFFLD
	MOVE	D,A		;DEST LENGTH
	EXTEND A,[MOVSLJ
		  " "]
	JFCL			;DUMMY ERROR RETURN
	SKIPL	DEFALT		;[41]IF NOT DEFAULTING VALUES
	 CALL	WS2VAL		;PUT SPACED OUT FIELD IN CORE TABLE
	JRST	SKPRET		;SKIP RETURN = NO CHANGES

%14.2:		;NUMERIC FIELD -- PUT NULL BYTE AT END
	MOVE	B,VALFLD	;SET-UP FOR RIGHT JUSTIFY MOVE
	MOVE	D,LENFLD
	TXNN	PRM,FULL%	;FULL FIELD REQUIRES NO MOD. OF SCREEN
	 CAMN	A,D		;NONE NEEDED IF ALL OF FIELD FILLED
	  AOS	(P)		;SET UP A SKIP IF ABOVE CONDITIONS MET
	MOVE	E,OFFFLD
	MOVE	C,B		;CHECK FOR LEADING MINUS OR PLUS.
	ILDB	Z,C		;GET LEAD CHARACTER
REPEAT 0,<  ;[110] FOLLOWING CODE IS PRIOR TO EDIT.
	TXNE	PRM,%DATE	;[5] SKIP IF NOT DATE
	 SKIPE	C,A		;[5] IF 0 TYPED, USE THAT LENGTH
	  MOVE	C,D		;SAVE LENGTH
	CAIE	"-"
	 CAIN	"+"
	  JRST	[IBP  B
		 IDPB 0,E
		 SOJ  D,
		 SOJA A,.+1]

>;[110] END OF REPEAT 0
;[110] FOLLOWING IS REPLACEMENT CODE FOR THE ABOVE
	CAIN Z,"-"		;IF FIRST CHARACTER IS MINUS SIGN
	 JRST [PUSH P,A		;  THEN OVERPUNCH THE LAST CHARACTER
	       ADJBP A,B	;   BY FIRST DETERMINING ITS POSITION
	       LDB Z,A		;    AND THEN GETTING THE CHARACTER
	       ADDI Z,"J"-"1"	;     AND OVERPUNCHING IT.
	       CAIN Z,"I"	;    IF IT WAS A ZERO THEN USE THE
		MOVEI Z,":"	;	NECESSARY SYMBOL.
	       DPB Z,A		;  PUT THE OVERPUNCHED SYMBOL BACK,
	       MOVEI Z,"-"	;   RESTORE THE SIGN TO THE REGISTER,
 	       POP P,A		;   RESTORE THE REGISTER
	       JRST .+1]	;   AND RETURN TO IN LINE.
	CAIE Z,"-"		;IF A SIGN WAS TYPED (EITHER MINUS OR
	 CAIN Z,"+"		;  PLUS)
	  JRST [MOVEI Z,"0"	;   THEN REPLACE IT WITH A LEADING ZERO
		DPB Z,C		;	SO THAT MOVE CAN WORK EASILY AND
		JRST .+1]	;	CONTINUE NORMALLY.

	TXNE PRM,%DATE		;[5]IF FIELD IS A DATE
	 SKIPE C,A		;[5] AND NO CHARACTERS TYPED USE ZERO LENGTH
	  MOVE C,D		;[5] ELSE USE FULL LENGTH.

;[110] END OF THE INSERT


	EXTEND	A,[MOVSRJ	;MOVE & JUSTIFY
		   "0"]		;ZERO FILL
	 JFCL			;IGNORE ERRORS
	MOVE	A,C		;RESTORE LENGTH
	CALL	SV.NUMRD		;SAVE NUMBER READ
	SKIPL DEFALT		;[41]IF NOT DEFAULTING
	 CALL	WS2VAL		; - XFER BACK TO VALUE
	RET
	SUBTTL	CKRG?? - CHECK RANGES; LW=LOWER, UP=UPPER, DATE=DATE

CKRGUP:
	TXNN	PRM,RANGU%
	 JRST	SKPRET		;NO RANGE CHECKING.
	LOAD	E,.URANG,C	;GET ADDRESS OF UPPER RANGE STRING.
	SUB E,V11SYM		;[35] OFFSET TO THE PROPER
	ADD E,V12SYM		;[35]  PAGE.
	TXNN PRM,%DATE		;[16]NO..BUT IS IT ANOTHER TYPE OF DATE?
	  JRST CKRGU2		;[16]NOT A DATE.
	LDB A,.SUBTP		;[16]GET THE TYPE OF DATE.
	CAIN A,%DATJU		;[16]IS IT JULIAN ?
	 JRST CKRGU2		;[16]YES..TREAT NORMALLY.
	CALL DATRNG		;[16]DATE (NON-JULIAN) SO DO SPECIAL.
	 SKIPL E		;[16]IS UPPER RANGE .LT. DATE ?
	  AOS (P)		;[16] NO.. THUS IT IS OK.
	 RET			;[16]RETURN.

CKRGU2: ;[16]
	CALL	CKRGSU		;DO SET-UP
	CALL CMPRNG		;[32]COMPARE RANGE  (DATE:RANGE)
	SKIPG C			;[32]IF DATE .LE. RANGE
	 AOS (P)		;[32]  THEN SKIP RETURN.
	RET			;[32]

CKRGLW:
	TXNN	PRM,RANGL%
	JRST	SKPRET		;NO CHECK NEEDED
	LOAD	E,.LRANG,C	;ADDRESS OF LOWER RANGE STRING.
	SUB E,V11SYM		;[35]OFFSET TO THE PROPER PAGE.
	ADD E,V12SYM		;[35]
	TXNN PRM,%DATE		;[16]NO..BUT IS IT ANOTHER TYPE OF DATE?
	  JRST CKRGL2		;[16]NOT A DATE, TREAT NORMALLY.
	LDB A,.SUBTP		;[16]GET TYPE OF DATE.
	CAIN A,%DATJU		;[16]IS IT JULIAN ?
	 JRST CKRGL2		;[16] YES..TREAT NORMALLY.
	CALL DATRNG		;[16]DATE (NON-JULIAN) SO DO SPECIAL.
	 SKIPG E		;[16]IS LOWER RANGE .GT. DATE ?
	  AOS (P)		;[16] NO.. THUS IT IS OK.
	 RET			;[16]RETURN.

CKRGL2: ;[16]
	CALL	CKRGSU		;SET-UP
	CALL CMPRNG		;[32]COMPARE  DATE:RANGE
	SKIPL C			;[32]IF DATE .GE. RANGE
	 AOS (P)		;[32]  THEN SKIP RETURN
	 RET			;[32]ELSE FALL THRU.

CKRGSU:
	MOVE	A,LENFLD
	MOVE	D,A		;EQUAL LENGTHS
	MOVE	B,OFFFLD	;SRC PTR = VALUE AFTER REFORMAT
	HRLI	E,(POINT 7,0)	;FORM A BYTE POINTER.
	TXNE PRM,NUMER%		;[110] IF THIS IS NUMERIC 
	 MOVE B,[POINT 7,INTBUF];[110]   THEN USE STORED VALUE.
	RET

;[32] START OF ROUTINE TO COMPARE RANGE

CMPRNG:
		;;A,B CONTAIN LENGTH, BYTE POINTER
		;;D,E CONTAIN LENGTH, BYTE POINTER
	PUSH P,A		;SAVE THE REGISTERS.
	PUSH P,B
	PUSH P,D
	PUSH P,E
	SETZM ISNEG		;INDICATE NO NEGATIVES SEEN.

	EXTEND A,[CMPSE]	;COMPARE STRINGS  EQUAL
	  SKIPA
	  JRST [SETZ C,		;INDICATE EQUAL
		JRST CMPR90]	;  AND RETURN

	MOVE E,(P)		;RESTORE VALUES
	MOVE D,-1(P)
	MOVE B,-2(P)
	MOVE A,-3(P)

	TXNN PRM,NUMER%		;IF FIELD IS ALPH OR ALPHANUMERIC
	 JRST CMPR20		;  THEN FORGET ABOUT MINUS SIGNS.

	ILDB C,B		;DETERMINE IF FIRST BYTE OF
	CAIE C,"-"		;  OF DATA IS NEGATIVE
	 JRST CMPR10		;AND IF NOT JUMP
	ILDB C,E		;DETERMINE IF FIRST BYTE OF
	CAIE C,"-"		;  OF RANGE IS NEGATIVE
	 JRST [SETO C,		;AND IF NOT THEN  D .LT. R
	       JRST CMPR90]	;   AND EXIT.
	SETOM ISNEG		;INDICATE THAT BOTH ARE NEGATIVE
	JRST CMPR20
CMPR10:		;HERE WHEN DATA NOT NEGATIVE
	ILDB C,E		;DETERMINE IF  RANGE IS NEGATIVE
	CAIN C,"-"		;IF IT IS NEGATIVE
	 JRST [MOVEI C,1	;  THEN DATA .GT. RANGE
	       JRST CMPR90]	;   IS SET AND EXIT

CMPR20:	;HERE WHEN BOTH HAVE THE SAME SIGN AND NOT EQUAL

	MOVE B,-2(P)		;RESTORE BYTE POINTERS
	MOVE E,(P)
	EXTEND A,[CMPSL]	;SO COMPARE STRINGS
	  SKIPA C,[1]		;INDCATE DATA .GT. RANGE
	SETO C,			; OTHERWISE  DATA .LT. RANGE
	TXNN PRM,NUMER%		;IF NOT A NUMERIC
	 JRST CMPR90		;THEN WE ARE DONE
	TXNE PRM,%DATE+%SSN	; IF SPECIAL NUMERIC
	 JRST CMPR90		;  THEN DONE ALSO
	SKIPE ISNEG		;IF BOTH SIGNS WERE NEGATIVE
	 MOVNS C		;THEN RESULT IS REVERSED
CMPR90:
	POP P,E			;RESTORE THE ARGUMENTS
	POP P,D
	POP P,B
	POP P,A
	RET			;AND RETURN
;[32] END OF PATCH

;==;==;==;==;==;==;==;==;==;==;

DATRNG:		;[16] TEST USER SUPPLIED DATE AGAINST RANGE
		;[16]  AND SET 'E'  -1,0,1 FOR (LT,EQ,GT)

	PUSH P,VALFLD		;[16]SAVE ADDRESS OF INPUT STRING.
	DMOVE A,DATBUF		;[16]MOVE USER'S DATE TO SAVE AREA
	DMOVEM A,USRDAT		;[16]
	MOVEM E,VALFLD		;[16]INSERT ADDRESS OF RANGE.
	CALL CKDT2		;[16]PUT INTO CONONICAL FORM IN DATBUF
	 JRST DATAR2		;[16]RANGE NOT IN GOOD FORMAT.
	DMOVE A,DATBUF		;[16]GET CONONICAL FORM OF RANGE.
	
	CAMLE A,USRDAT		;[16]IS RANGE(1) .GT. DATE(1) ?
	 JRST [MOVEI E,1	;[16]  YES...TELL CALLER
	       JRST DATAR3]	;[16]TEST COMPLETED.
	CAME A,USRDAT		;[16]IS RANGE(1) .LT. DATE(1) ?
	 JRST [SETO E,		;[16]YES..
	       JRST DATAR3]	;[16]TEST COMPLETED.
	CAMLE B,USRDAT+1	;[16]RANGE(2) .GT. DATE (2)?
	 JRST [MOVEI E,1	;[16]IT IS GREATER
	       JRST DATAR3]	;[16]TEST COMPLETED.
	CAME B,USRDAT+1		;[16]RANGE(2) .EQ. DATE(2)?
	 JRST [SETO E,		;[16]NO..THEN IT IS LESS.
	       JRST DATAR3]	;[16]TEST COMPLETED.
	SETZ E,			;[16]YES..INDICATE EQUAL
	JRST DATAR3		;[16]TERMINATE TEST.
DATAR2:				;[16]RANGE NOT GOOD FORMAT--SAY IN RANGE
	SETZ E,			;[16]
DATAR3:				;[16]TERMINATION OF DATRNG
	DMOVE A,USRDAT		;[16] AND ALSO RESTORE
	DMOVEM A,DATBUF		;[16]  THE INTERNAL FORM OF THE DATE.
	POP P,VALFLD		;[16]RESTORE CURRENT VALUE POINTER
	RET



CKDATE:		;CHECK THE VALIDITY OF THE DATE
	LBL	30

	LOAD	C,.NUMRD,D	;[5] ANY CHARACTERS TYPED ?
	JUMPE	C,SKPRET	;[5] NO - DON'T VALIDITY CHECK

CKDT2:
	LDB C,.SUBTP		;[16]GET THE DATE TYPE.
	CAIN C,%DATJU		;[16]IS IT JULIAN ?
	 JRST %30.9		;[16]YES..TREAT SEPARATELY.

		;;EXTRACT MONTH AND VERIFY DIGITS.
	SETZM	DATBUF		;[16] CLEAR DATE STORAGE AREA
	SETZM	DATBUF+1	;[16] (2 WORDS)

	MOVE	A,VALFLD
	HRLI	A,(POINT 14,0,13)
	TXNE	PRM,%SUB1	;SUB TYPE 1 OR 4
	 HRLI	A,(POINT 21,0,34);NO
	CAIN C,%DATCA		;[102] IF THIS IS THE CANADIAN DATE
	 HRLI A,(POINT 14,0,27)	;[102]  THEN SET TO LOOK FOR MONTH.
	LDB E,A			;[16]GET THE MONTH STRING.
	MOVEI A,MMMTAB		;[16] ADDRESS OF 3 LETTER TABLE NAMES
	TXNN PRM,%SUB1		;[16] IS IT A SLASH/DASH ?
	 MOVEI A,MNMTAB		;[16] YES.. USE THE 2 DIGIT TABLE.
	CAIN C,%DATCA		;[102] IF THIS IS A CANADIAN DATE
	 MOVEI A,MNMTAB		;[102]   THEN USE 2 DIGIT TABLE
	PUSH	P,C
	CALL TBLUK.		;[16] DO SEQUENTIAL LOOKUP IN TABLE
				;[16]   RETURNS MONTH NUMBER IN 'A'.
				;[16]	AND 'B' = -1 IF NOT IN TABLE
	POP	P,C

	JUMPL	B,%30.8		;[16]JUMP IF NOT A PROPER MONTH.
	MOVE B,MNMTAB(A)	;[16] GET THE MONTH NUMBER
	DPB B,DBMMBP		;[16] DEPOSIT IN DATBUF
	MOVE E,A		;[16]SAVE MONTH NUMBER.

		;;EXTRACT DAY AND VERIFY DIGITS.
	MOVE	B,VALFLD
	HRLI	B,(POINT 14,0,27)
	CAIE	C,%DATDE
	 CAIN	C,%DATMI
	  HRLI	B,(POINT 14,0,13) ;SLASH/DASH
	CAIN C,%DATCA		;[102]IF THIS IS A CANADIAN DATE
	 HRLI B,(POINT 14,0,13)	;[102]  THEN GET THE DAY
	LDB A,B			;[16]GET THE DAY OF THE MONTH.
	DPB A,DBDDBP		;[16]SAVE THE DAY
	LSHC A,-7		;[16]LEAVE ONLY FIRST DIGIT.
	CAIL A,"0"		;[16]IS DIGIT LESS THAN 0 OR
	 CAILE A,"9"		;[16] GREATER THAN 9 ?
	  JRST %30.8		;[16]YES.. THEN NOT A DIGIT.
	SETZ A,			;[16] CLEAR OUT THIS DIGIT
	LSHC A,7		;[16]GET SECOND DIGIT BACK
	CAIL A,"0"		;[16]IS DIGIT LESS THAN 0 OR
	 CAILE A,"9"		;[16] GREATER THAN 9 ?
	  JRST %30.8		;[16]YES.. THEN NOT A DIGIT.
	LDB A,DBDDBP		;[16] GET THIS BACK.
	CAIL A,"01"		;[16]IS IT LESS THAN 01 ?
	 CAMLE A,MLDTAB(E)	;[16]OR GREATER THAN LAST DAY OF MONTH?
	  JRST %30.8		;[16]NO...ERROR

	;; NOW GET AND VALIDATE THE YEAR


	MOVE D,VALFLD		;[16]GET ADDRESS OF DATE FIELD.
	CAIE C,%DATDE		;[16] IS IT A DEC
	 CAIN C,%DATMI		;[16]   OR DASH DATE ?
	  SKIPA			;[16]YES...
	  JRST %30.6		;[16]NO..SLASH OR DASH

	LDB A,[POINT 14,1(D),13] ;[16]  GET YEAR IN DDMMMMYY
	JRST %30.7		;[16] AND CONTINUE

%30.6:				;[16] SLASH/DASH DATE
	LDB A,[POINT 7,1(D),6] ;[16] GET THE SECOND DIGIT IN YY
	LSHC A,-7		;[16] SHIFT INTO 'B'
	LDB A,[POINT 7,(D),34]	;[16] GET FIRST DIGIT
	LSHC A,7		;[16]  AND THEN SHIFT BOTH INTO 'A'.
%30.7:
	DPB A,DBYYBP		;[16] DEPOSIT THE YEAR
	LSHC A,-7		;[16] TEST FOR 00 TO 99 RANGE
	CAIL A,"0"		;[16] IS FIRST CHAR A DIGIT ?
	 CAILE A,"9"		;[16]  0-9 ?
	  JRST %30.8		;[16] NO... AND ERROR

	SETZ A,			;[16] CLEAR OUT FIRST DIGIT
	LSHC A,7		;[16] AND GET THE SECOND
	CAIL A,"0"
	 CAILE A,"9"
	  JRST %30.8
	AOS (P)			;[16] GOOD YEAR
%30.8:	RET			;ERROR RETURN (NO SKIP).

%30.9:		;HERE WHEN JULIAN DATE
	MOVE D,VALFLD		;[16]GET ADDRESS OF USER DATE FIELD.
	LDB E,[POINT 21,(D),34]	;[16] GET THE DAY
	CAML E,["001"]		;[16] IS IT LSS THAN 001 
	 CAMLE E,["366"]	;[16]  OR GREATER THAN 366 ?
	  SKIPA			;[16] YES... THEN ERROR
	AOS (P)
	RET

TBLUK.:		;[16] THIS IS THE TABLE LOOKUP FOR MONTH TABLES
		;[16]	THE TABLE ADDRESS IS IN 'A' AND THE MONTH
		;[16]	IS IN 'E'.

	PUSH P,A		;[16]SAVE REG 'A'.
	HRLI A,-^D12		;[16]NEGATIVE TABLE SIZE IN LEFT HALF.
	SETZ B,			;[16]B=0 INDICATES FOUND, B=-1,NOT FOUND
TBLK1.:
	CAMN E,(A)		;[16]IS THIS THE ONE ?
	 JRST TBLK2.		;[16] YES..
	AOBJN A,TBLK1.		;[16]NO..JUMP IF MORE
	SETO B,			;[16]IT IS NOT THERE
TBLK2.:		;[16] IS HAS BEEN FOUND
	POP P,C			;[16]RESTORE TABLE ADDRESS
	HRRZS A			;[16]RESULT ADDRESS ONLY
	SUBI A,(C)		;[16]OFFSET INTO TABLE.
	RET			;[16]

;[16] END OF EDIT [16] DATE FORMAT AND RANGE CHECKING CODE
	SUBTTL	INTCFD - INITIALIZE CURRENT FIELD & RESTORE STATE OF WORLD

INTCFD:
	PUSH	P,INT.A
	PUSH	P,CURFLD
	MOVE	INT.A,CURFLD
	SETZM	CURFLD
	CALL	INITAL
	POP	P,CURFLD
	POP	P,INT.A
	RET





	SUBTTL  REGISTER LOAD/SAVE ROUTINES

SV.NUMRD:
	STORE	A,.NUMRD
	RET

LD.NUMRD:	;LOAD REGISTER 'A' WITH COUNT OF CHARS
	LOAD A,.NUMRD
	RET
	SUBTTL	FLDRD  - READ A FIELD AND SET .NUMRD & PRDUP IF MSDUP
	LBL 24 ;=20 DECIMAL

COMMENT	+

	IF SPECIAL-TYPE-OF-FIELD
	   THEN CALL SUBFLD
		CALL INTRD
		UNTIL SUBFLD RETURNS ZERO
	ELSE
	   CALL INTRD;
	RETURN (A=NUMBER READ; B=TERMINATING CHARACTER)

	+

FLDRD:
	MOVEI A,PNCCHR		;[57]SET TO ALLOW SPACES IN ALPHABETICS
	TXNE PRM,%SPACE		;[57]  IF FIELD HAS BIT SET
	 MOVEI A,ALPCHR		;[57] AND IF
	TXNE PRM,ALPHA%		;[57]FIELD IS ALPHABETIC
	 MOVEM A,CHRTAB+40	;[57]

	SETZM	FRSTSB			;[27]INDICATE IN FIRST SUBFIELD.
	TXNN	PRM,<%TYPE^!%YN>	;ANY SPECIAL BITS SET ?
	 JRST %24.5			;NO--NOT A SUBFIELD.
%24.2:	CALL SUBFLD			;GET NEXT SUBFIELD
	 RET				;NO MORE SUBFIELDS.
	JUMPE	C,%24.2		;DON'T READ EMPTY FIELDS
	CALL	INTRD		;READ THIS FIELD.
	ADDM	A,TOTNRD	;ADD IN TOTAL # READ
	JUMPN	B,RSTRET
	MOVE	E,TRMCHR
	CAIN	E,TRM.LN	;LENGTH ?
	 JRST [SETOM FRSTSB	;[27] YES--INDICATE IN NEXT SUBFIELD
	       JRST %24.2]	;[27]
RSTRET:
	CALL	RSTCPM		;PUT BACK WORLD IF ESC TYPED
	RET

%24.5:	CALL	INTRD		;READ THIS FIELD.
	RET

SAVCPM:
	MOVE	A,[LINFLD,,SAVFLD]
	BLT	A,SAVFLD+4
	SETZM	TOTNRD		;NONE READ SO FAR
	RET

RSTCPM:
	MOVE	A,[SAVFLD,,LINFLD]
	BLT	A,OFFFLD
;**;[115] REPLACE @ RSTCPM+3	BPK	14-SEP-79
	SETOM	SUBX		;[115] MAKE SURE SUB-F STUFF WORKS OK
	SKIPN	A,TOTNRD	;[115] IF NO CHARACTERS TYPED
	RET			;[115] THEN NO NEW DATA
	SKIPL	PREDUP		;[115] IF NEW DATA IN PREVIOUS
	SETOM	NEWDAT		;[115] DUPE FIELD, INDICATE IT.
	RET			;[115]
	SUBTTL	INTRD  - INTERNAL READ ROUTINE FOR ONE FIELD


COMMENT	+

	1..POSITION CURSOR;
	2..SET UP PTR TO VALUE IN CORE
	3..IF NUMERIC
	   4..SET UP TEXTI FOR NUMERIC
	   5..ELSE SET UP FOR A-N;
	6..DO TEXTI UNTIL . . .
	7.. NOT SPECIAL CHARACTER
	8..IF UNACCEPTABLE CHARACTER
	   9..GO TO 6
	10..GOOD END (TAB)
	11..GOOD END (LENGTH)
	12..SPECIAL END (LF, CR, ESC)
	13..BACKSPACE (BS)
	14..RETURN LENGTH READ AND TERMINATOR
	+

	LBL 23			;A BRAND NEW LABEL JUST FOR US

INTRD:				;INTERNAL READ OF A FIELD
	DMOVE A,LINFLD		;WITH FIELD'S LINE AND COLUMN,
	CALL $POSIT		; POSITION CURSOR
	CALL $SEND		;[64]AND FORCE POSITIONING OUT

	MOVE	A,VALFLD	;SET UP POINTER TO CORE VALUE AREA.
	MOVEM	A,TXTTAB+.RDDBP	;DESTINATION BYTE POINTER
	MOVEM	A,TXTTAB+.RDBFP	;BACKUP LIMIT FOR CTRL-U ETC.

;**; [112] CHANGE AT INTRD + 6	CLRH	28-JUL-80
;[112]	TXNN PRM,NUMER%		;IF FIELD IS NOT NUMERIC 
;[112]	 JRST %23.5		;  THEN CHECK FOR ALPHA ONLY.
;[112];[15]	MOVEI	A,TXTNUM	;  ELSE SETUP FOR NUMERIC BREAKS
;[112];[15]	MOVEM	A,TXTTAB+.RDBRK	;SAVE BREAK SET ADDRESS
;[112]	MOVEI A,ALPCHR+PNCCHR+CONCHR+FCCCHR ;[15] ALL BUT NUMERICS
;[112]	MOVEM A,FLDTYP		;[15] STORE THE BREAK SET.
;[112]	JRST	%23.6
;[112]
;[112]%23.5:		;HERE IF NOT A NUMERIC FIELD, MAY BE ALPHA ONLY.
;[112];[15]	MOVEI	A,TXTAN		;ALPHANUMERIC BREAKS
;[112]	MOVEI A,CONCHR+FCCCHR	;[15]BREAK ONLY ON CONTROL CHARACTERS
;[112]	TXNE	PRM,ALPHA%	;IF ALPHA ONLY
;[112]	MOVEI A,CONCHR+FCCCHR+PNCCHR+NUMCHR ;[15]BREAK ON ALL BUT ALPHAS.
;[112]	MOVEM A,FLDTYP		;[15] STORE THE BREAK SET.
;[112]
;[112]%23.6:		;;ALL DATA TYPES RETURN HERE FOR READ.
	MOVE	A,FLDTYP	;[112] SAVE THE CURRENT
	MOVEM	A,OLDTYP	;[112] FILED TYPE (N,A,A WITH BLANK, AN)
	SETZM	MSKIDX		;[112] INITIALIZE MSKTAB INDEX TO NUMERIC
	TXNN	PRM,NUMER%	;[112] IF FIELD IS NOT NUMERIC
	 JRST	%23.5		;[112]  THEN CHECK FOR ALPHA ONLY
	MOVEI	A,ALPCHR+PNCCHR+CONCHR+FCCCHR	;[112] ALL BUT NUMERICS
	JRST	%23.6		;[112]

%23.5:			;[112] HERE IF NOT A NUMERIC FIELD, MAY BE ALPHA ONLY
	TXNN	PRM,ALPHA%	;[112] IF FIELD IS ALPHANUMERIC
	 JRST	%23.5A		;[112]  THEN DEAL WITH THAT
	AOS	MSKIDX		;[112] INDICATE AT LEAST ALPHA ONLY
	MOVE	A,CHRTAB+40	;[112] IF ALPHA-ONLY INCLUDES BLANKS
	CAIN	A,ALPCHR	;[112]
	 AOS	MSKIDX		;[112] THEN SET INDEX APPROPRIATELY
	MOVEI	A,CONCHR+FCCCHR+PNCCHR+NUMCHR	;[112] BREAK ON ALL BUT ALPHAS
	JRST	%23.6		;[112] COMMON CODE

%23.5A:			;[112] HANDLE THE ALPHANUMERIC CASE
	MOVEI	A,3		;[112] SET THE MSKTBL INDEX
	MOVEM	A,MSKIDX	;[112]  TO ALPHANUMERIC
	MOVEI	A,CONCHR+FCCCHR	;[112] BREAK ONLY ON CONTROL CHARACTERS
	JRST	%23.6		;[112] COMMON CODE

%23.6:			;[112] ALL DATA TYPES RETURN HERE FOR READ.
	MOVEM	A,FLDTYP	;[112] SET THE FIELD TYPE
	CAME	A,OLDTYP	;[112] IF NOT SAME AS OLD TYPE
	 CALL	SETTYP		;[112] THEN SET THE TYPE UP
	MOVE	INT.C,LENFLD	;SAVE MAX LENGTH AVAIL FOR INPUT
	MOVEM	INT.C,TXTTAB+.RDDBC	;DESTINATION BYTE COUNT

%23.TI:	;[15] MOVE THIS TAG HERE AFTER ELIMINATING THE CODE.
	MOVEI	A,TXTTAB	;POINT TO DATA BLOCK
	SETZM	TRMCHR		;NO TERM CHAR YET
	CALL TEXTI.		;[15] READ THE FIELD,RETURN LAST CHAR
				;[20] IN 'E'.
	 JFCL			;[15]PLAN FOR SKIP RETURN

	MOVE	B,TXTTAB+.RDFLG		;DETERMINE IF ACCEPTABLE CHAR.
	TXNN	B,RD%BTM	;BREAK TERMINATED TEXTI ?
	 JRST	%23.LN		;NO MUST BE LENGTH DONE

;[20]	SETZ	E,		;GET LAST BYTE READ
;[20]	LDB	E,TXTTAB+.RDDBP	;USE DESTINATION BYTE POINTER
	CAIN	E,11		;TAB
	 JRST	%23.TB
	CAIN	E,10		;BS
	 JRST	%23.BS
	CAIN	E,12		;LF
	 JRST	%23.LF
	CAIN	E,14		;FF
	 JRST	%23.FF
	CAIN	E,15		;CR
	 JRST 	%23.ES
	CAIN	E,33		;ESCAPE
	 JRST	%23.ES

REMARK	TEST FOR LEADING OPERATION SIGN IF NUMERIC
	TXNE	PRM,%DATE+%SSN	;SIGN NOT LEGAL FOR DATE AND SSN
	 JRST	%23.8
	TXNN	PRM,NUMER%
	 JRST	%23.8		;NOT NUMERIC
	MOVE A,INT.C		;[21]LENGTH OF SUBFIELD
	SUB A,TXTTAB+.RDDBC	;[21]AND COMPUTE THE NUMBER OF CHARS
	SOJG A,%23.8		;[21]NOT THE FIRST CHARACTER.
	SKIPE FRSTSB		;[27]IF NOT THE FIRST SUB FIELD
	 JRST %23.8		;[27]  THEN ALSO AN ERROR.
	CAIE	E,"-"		;LEADING SIGN
	 CAIN	E,"+"
	  SKIPA			;YES-OK.
	  JRST	%23.8		;NO - ILLEGAL CHARACTER
	MOVEI A,"0"		;[21]IF A PLUS REPLACE WITH 0.
	CAIN E,"+"		;[21]IS IT A PLUS ?
	 DPB A,TXTTAB+.RDDBP	;[21] YES...REPLACE IT.
	JRST %23.TI		;[21]CONTINUE

;;;;;;;;;;;;;;;;;;; ERRONEOUS CHARACTER ;;;;;;;;;;;;;;;;

%23.8:

	HRROI	C,MSG.NN	;GUESS NOT NUMERIC
	TXNN	PRM,NUMER%	;SKIP IF RIGHT
	 HRROI	C,MSG.NA	;WRONG - THEN ALPHA
	TXNE	PRM,ALPHA%	;JUST ALPHA ?
	 HRROI	C,MSG.AO	;WRONG AGAIN - ALPHA ONLY
	PUSH P,E		;SAVE THE CHARACTER.
	CALL	INTERR		;INTERNAL ERROR CALL
	CALL	BACKUP		;BACK UP THE TEXTI POINTERS
	POP P,E			;RESTORE THE CHARACTER.
	CAIGE E,40		;IF AN ILLEGAL CONTROL CHARACTER
	 JRST [CALL BACKCU	;BACKUP THE CURSOR
	       JRST %23.TI]	;    AND CONTINUE.
	CALL	DOABS		;BACKSPACE CURSOR ON SCREEN IF ANY
	JRST	%23.TI		;DO TEXTI WITHOUT REINITTING

%23.TB:	CALL BACKUP		;T A B  -- ENDED FIELD READ.
	MOVEI	A,TRM.TB	;TAB TERMINATOR
	JRST	%23.12		;COMMON ENDING

%23.LN:	MOVEI A,TRM.LN		;READ TERMINATED ON LENGTH.
	JRST	%23.12

%23.CR:	MOVEI A,1		;[33] C R --ENDED READ (JUSTIFY FIELD)
	MOVEM A,DEFALT		;[33]  IF REQUIRED.
	MOVEI	A,TRM.CR
	SKIPE OLDCR		;[37]IF USER WANT'S CR.EQ.LF
	 MOVEI A,TRM.LF		;[37]  THEN DO IT.
	JRST	%23.12

%23.LF:	CALL BACKUP		;L F (LINE FEED) TERMINATED READ.
	MOVEI Z,1		;[33]JUSTIFY LAST FIELD
	MOVEM Z,DEFALT		;[33]  IF REQUIRED.
	MOVEI	A,TRM.LF
	JRST	%23.12

%23.FF:	CALL BACKUP		;F F (FORM FEED) TERMINATED READ.
	MOVEI Z,1		;[33]JUSTIFY LAST FIELD
	MOVEM Z,DEFALT		;[33]  IF REQUIRED.
	MOVEI	A,TRM.FF
	JRST	%23.12

;;;;;;;; FIELD OR SUBFIELD ALL IN -- SO CHECK LEGALITY ;;;;;;;;
;[27]  MAKE ALL THIS WORK RIGHT

%23.12:
	MOVEM A,TRMCHR			;SAVE THE TERMINATION CODE.
	SKIPE FRSTSB			;[27]IF NOT IN FIRST FIELD
	 JRST %2312K			;     THEN BYPASS CHECKS
	MOVE A,INT.C			;COMPUTE THE NUMBER OF CHARS
	SUB A,TXTTAB+.RDDBC		;  TYPED IN.
	SOJGE A,%2312K			;IF ANY TYPED BYPASS CHECKS
					;NO CHARACTERS TYPED
	TXNN PRM,REQD%			;IF NOT A REQUIRED FIELD
	 JRST %2312Z			;  THEN ALL IS GOOD
					;NO CHARACTERS TYPED, BUT REQUIRED.
	TXNN PRM,PRDUP%			;IF NOT PREVIOUS DUPE
	 JRST [SKIPE MAXFLD		;[71]IF BACKING OVER THE FIELD
		 JRST .+1  		;[71] THEN TREAT LIKE PREV-DUPE.
		 JRST %2312G]		;[71]  ELSE TREAT AS BLANK FIELD.
	CALL LD.NUMRD			;GET LAST AMOUNT IN PREV DUPE
	JUMPG A,%2312Z			; AND NO CHECKS IF MORE THAN 0.


%2312G:			;NO CHARACTERS TYPED--BUT THEY WERE REQUIRED
	HRROI C,MSG.RQ		;SO ISSUE ERROR
	CALL INTERR
	JRST %23.TI

%2312K:
	TXNN PRM,FULL%			;IF THIS IS NOT A FULL FIELD
	  JRST %2312P			;  THEN DO NOT CHECK FOR IT.
	SKIPN TXTTAB+.RDDBC		;IF FIELD WAS FULL
	 JRST %2312P			;  THEN GO ON TO NEXT CHECK.
	HRROI C,MSG.FF			;  ELSE DO THE ERROR MESSAGE.
	CALL INTERR
	JRST %23.TI
%2312P:
	TXNN PRM,%YN			;IF THIS IS NOT A YES/NO FIELD
	  JRST %2312Z			; THEN WE WON THE CHECKS.
	MOVE	C,TXTTAB+.RDBFP ;GET BEG OF FIELD PTR
	ILDB	B,C
	CAIE	B,"Y"		;YES
	 CAIN	B,"N"		;NO
	  JRST %2312Z		;YES.
	HRROI	C,MSG.YN
	CALL	INTERR
	CALL	BACKUP
	CALL	DOABS
	JRST	%23.TI
%2312Z:
	JRST	%23.14
;[27] END OF VALIDITY CHECKING ON SUBFIELD LEVEL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


%23.BS:	CALL BACKUP		;B S (BACKSPACE) TERMINATED READ.
	JRST %23BAK		;DO THE BACKUP.

;;;;;;;;;;;
%23.14:	SETZ B,		;RETURN LENGTH AND TERMINATOR.
%23.CE:
	SETOM NEWDAT		;INDICATE NEW DATA WAS ENTERED.
	MOVE A,INT.C	;COMMON EXIT --COMPUTE # CHARS READ.
	SUB	A,TXTTAB+.RDDBC ;BYTES READ
	SKIPE A			;IF USER ENTERED DATA THEN
	 RET			;  RETURN WITH COUNT IN 'A'.
	SETZM NEWDAT		;INDICATE NO NEW DATA WAS ENTERED.
	SKIPE MAXFLD		;[71]IF IN A BACKUP MODE
	 PJRST LD.NUMRD		;[71]  THEN GET THE OLD COUNT.
	TXNE	PRM,PRDUP%	;RET IF NORMAL FIELD
	 CALL LD.NUMRD		;ELSE LENGTH IS SAME AS LAST LENGTH
	RET

%23.ES:	CALL BACKUP		;E S C (ESCAPE/SEL) TERMINATED.
	CALL	ECOOFF		;TURN OFF ECHO
	CALL $RDCHAR		;GET THE CHARACTER
	push	p,a
	CALL	ECOON		;BACK ON
	pop	p,a
	SKIPE OLDUD		;[37]IF UP-DOWN ARROW ILLEGAL THEN
	 JRST %23ESA		;[37]  THEN DO NOT CHECK ON ARROWS.

	CAIE A,"A"		;IF UP ARROW OR
	 CAIN A,"B"		;   DOWN-ARROW THEN
	  JRST	%23.CR		;      TREAT LIKE CARRIAGE RETURN.

	CAIE A,"C"		;IF RIGHT-ARROW OR
	 CAIN A,"D"		;  LEFT ARROW THEN
	  JRST [SKIPE OLDAR	;[37]  IF NO SPECIAL TREATMENT
		 JRST %23.CR	;[37]   THEN TREAT AS CARRIAGE RETURN
		JRST %23ESB]	;[37]   ELSE DO SPECIAL TREATMENT

%23ESA:    ;NOT AN ESC-ARROW OR NOT PROCESSING THESE.
	CAIN A,12		;IF LINE-FEED AFTER A CARRIAGE RETURN
	 JRST %23.CR		;  THEN PROCESS THE CARRIAGE RETURN.
	SETZ	B,
	CAIN	A,"P"		;PUNT FIELD
	 MOVEI	B,1
	CAIN	A,"Q"		;PUNT SECTION
	 MOVEI	B,2
	CAIN	A,"R"		;REFRESH SCREEN
	 MOVEI	B,3
	SKIPE	B
	 JRST	%23.CE

	HRROI	C,MSG.ES	;BAD ESCAPE SEQUENCE
	CALL	INTERR
	JRST	%23.TI		;INPUT SOME MORE

%23ESB:		;SPECIAL HANDLING FOR RIGHT AND LEFT ARROW.
	CAIN A,"D"		;IF LEFT-ARROW 
	 JRST %23ESC		;  THEN GO PROCESS IT
	MOVEI A,TRM.TB		;ELSE TREAT IT AS A TAB
	JRST %23.12
%23ESC:			;LEFT ARROW.
%23BAK:		;BACKUP CODE
	CALL BACKUP		;DO A LOGICAL BACKUP
	 JRST	[CALL DOABS	;THERE WAS A CHARACTER
		 JRST	%23.TI]	;FINISH TEXTI
	HRROI	C,MSG.BU	;BACK UP NO FURTHER
	CALL	INTERR		;TELL USER
	JRST	%23.TI		;TRY AGAIN

BACKUP:
	CAMG	INT.C,TXTTAB+.RDDBC	;ANY BYTES LEFT ?
	JRST	SKPRET		;SKIP RETURN IF NONE LEFT
	SETO	A,		;MINUS ONE BYTE
	IBP	A,TXTTAB+.RDDBP	;IN B
	MOVEM	A,TXTTAB+.RDDBP
	AOS	TXTTAB+.RDDBC	;UP BYTES REMAINING
	RET

DOABS:
		;REPOSITION THE CURSOR TO LAST CHARACTER
	PUSH	P,A
	PUSH	P,B
	MOVE	B,HICOLM		;IF WE HAVE PASSED THE
	CAMGE	B,INTCOL		;  END OF THE SCREEN
	 JRST	[MOVE A,LINFLD		;     THEN POSITION THE HARD
		 SETOM INTCOL		;	WAY.
		 CALL $POSIT
		 JRST INTTRB]
	CALL BACKCU			;     ELSE JUST BACKUP THE CURSOR.
INTTRB:
	MOVE A,FILCHAR		;SET UP THE FILLER CHARACTER.
	CALL $SCHAR		;[64]SEND CHARACTER IN 'A'
	CALL $SEND		;[64]AND MAKE SURE IT GOES.
	SKIPGE	INTCOL		;IF THE LAST CHARACTER WAS OFF THE SCREEN
  	 JRST	[AOS INTCOL	;   THEN MERELY CONTINUE
		 POP	P,B
		 POP	P,A
		 RET]
	CALL BACKCU		;   ELSE BACKUP CURSOR.
	POP	P,B
	POP	P,A
	RET

BACKCU:		;BACKUP CURSOR.
	PUSH P,A
	MOVEI A,33		;USE THE ESC-D SEQUENCE
	CALL $SCHAR		;[64]SEND CHARACTER IN 'A'
	MOVEI A,"D"
	CALL $SCHAR		;[64]SEND CHARACTER IN 'A'
	CALL $SEND		;[64]AND MAKE SURE IT GOES.
	POP P,A
	RET


SKPRET:	AOS (P)		;SKIP RETURN
	RET
	SUBTTL  ----- PHYSICAL DATA ENTRY ROUTINE -- TEXTI.


;**********************************************
;
;[15] --- ROUTINES FOR SIMULATING TEXTI. ROUTINE
;
;**********************************************

TEXTI.:	;REPLACEMENT ROUTINE FOR TEXTI JSYS

	PUSH P,PRM		;SAVE THIS REGISTER
	MOVEI PRM,(A)		;SAVE POINTER TO TXTTAB
	SKIPG B,.RDDBC(PRM)	;IF ZERO OR LESS CHAR COUNT
	 JRST GOODCHR		; THEN INDICATE WE ARE DONE.
	SKIPE	ERRDSP		;[126] MUST TRIGGER WAKE UP
	MOVEI	B,1		;[126] TO CLEAR ERROR MESSAGE
;**; [112] INSERT AT TEXTI. + 3 1/2	CLRH	28-JUL-80
	CALL	SETLEN		;[112] TELL MONITOR THE LENGTH
	SETZM ISTAB		;[20] INDICATE NO TAB ON PREVIOUS DUPE SEEN.
	MOVE A,FILCHAR		;[25] SAVE THE FILLER FOR ERRORS
	SKIPE PREDUP		;[25]IF THIS IS PREVIOUS DUPE
	JRST [MOVEI B,1		;[125] SET LENGTH TO ONE
	      CALL SETLEN	;[125] TO BREAK AFTER 1ST CHAR
	      MOVE B,.RDDBP(PRM)	;[125] [25] THEN
	       ILDB A,B		;[25]        GET SAVE THE FIRST
	       JRST .+1]	;[25]		CHARACTER
	MOVEM A,FRSTCHR		;[25]
	SETZ A,			;[72]CLEAR INPUT CHARACTER

TXTI.:	CALL $RDCHAR		;LOOP FOR CHARACTERS
	JUMPE A,TXTI.		;[72]IF NULL FORGET IT (FOR CONTROL/C)

	SKIPE ERRDSP		;WAS THERE AN ERROR ON LAST CHARACTER?
	 CALL TXTERR		;YES---GO CLEAR IT.
	SKIPE PREDUP		;ARE WE ABOUT TO DO A PREVIOUS DUP ?
	 JRST [CALL TXTPRE	;YES -- HANDLE IT
		JRST .+1	;NORMAL RETURN
		JRST .+2	; BYPASS DEPOSITING THE CHARACTER
		JRST TXTI.]	; BACKSPACE
	IDPB A,.RDDBP(PRM)	;DEPOSIT THE CHARACTER.
	SOS B,.RDDBC(PRM)	;SUBTRACT 1 FROM CHARACTER COUNT
	MOVE C,FLDTYP		;GET TYPE OF DATA TO INTERRUPT ON
	TDNN C,CHRTAB(A)	;IS IT INTERRUPT CHARACTER ?
	 JRST GOODCHR		;NO...SEE IF FIELD DONE

	MOVE B,[RD%BTM]		;INDICATE BREAK ENDED FIELD
	MOVEM B,.RDFLG(PRM)	;STORE IT.
DONCHR:
	MOVEI E,(A)		;[20]RETURN FINAL CHARACTER.
	POP P,PRM		;RESTORE REGISTER
	AOS (P)
	POPJ P,			;RETURN TO USER

GOODCHR:
	JUMPG B,TXTI.		;NOT FINISHED
	SETZM .RDFLG(PRM)	;INDICATE GOOD LENGTH
	JRST DONCHR

TXTERR:			;ERROR ON LAST CHARACTER---CLEAR IT.

	CAIN A,33		;IF AN ESCAPE THEN
	 RET			; HONOR IT.
	PUSH P,A
	CALL CLRERR		;CLEAR OFF THE ERROR MESSAGE
	SETZM ERRDSP		;TURN OFF INDICATOR

	MOVE B,LENFLD		;GET THE FIELD LENGTH
	SUB B,.RDDBC(PRM)	; AND SUBTRACT NUMBER OF CHARS LEFT.
	AOS B			;
	ADD B,COLFLD		;GET COLUMN NUMBER
	MOVE A,LINFLD		;GET THE LINE NUMBER
	CALL $POSIT		;POSITION
	MOVE A,(P)		;GET THE CHARACTER BACK
	CAIN A,10		;[30]IF THIS IS A BACKSPACE
	 CALL $SCHAR		;[64]SEND THE CHARACTER OUT
	CALL $SEND		;[64]MAKE SURE IT GOT THERE
	MOVE	B,.RDDBC(PRM)	;[126] TAKE REMAINING CHARACTERS
	SOS	B		;[126] SUBTRACT ONE
	CALL	SETLEN		;[126] RESET LENGTH BREAK
	POP P,A			;RESTORE THE CHARACTER
	RET


TXTPRE:		;STARTING A PREVIOUS DUP FIELD

	MOVEI B,FCCCHR+CONCHR	;[25]LEAVE PREDUPE FIELD ON ANY
	TDNN B,CHRTAB(A)	;[25]   END OF FIELD CHAR.
	 JRST TXTP50		;NO..USER IS TYPING A NEW VALUE
	SETOM ISTAB		;[20] INDICATE TABBED OUT OF PREVIOUS DUPE.
	CAIN A,10		;[25] IF THIS IS A BACKSPACE

	 JRST [ AOS (P)		;[25]   THEN DO NOT MOVE
		AOS (P)		;[25]	   THE CURSOR
		RET]		;[25]
	IBP .RDDBP(PRM)		;[20]  BUT ACT AS IF WE DID.
	AOS (P)			;[20]DO NOT DEPOSIT CHARACTER
	RET			;AND CONTINUE NORMALLY.

TXTP50:		;HERE WHEN USER WANTS TO CONTINUE.

	SETZM PREDUP		;FLAG PREVIOUS DUPE INDICATOR
	PUSH P,A		;SAVE CURRENT CHARACTER
	MOVE A,FILCHAR		;REPLACE WITH THE FILLER.
	MOVEM A,FRSTCHR
	PUSH P,LINFLD		;[46]SAVE THE CURRENT LINE NUMBER,
	PUSH P,COLFLD		;[46]  COLUMN NUMBER,
	PUSH P,PRM		; AND INDEX

	PUSH P,INT.A		;SAVE THE WORLD
	PUSH P,CURFLD

	PUSH P,C
	PUSH P,LENFLD
	PUSH P,SUBX
	PUSH P,SUBY
	PUSH P,SUBP

	MOVE INT.A,CURFLD	;SET UP TO POINT AT CURRENT FIELD
	SETZM CURFLD		;INDICATE CURRENT FIELD
	CALL INITAL		; AND INITIALIZE IT.
	POP P,SUBP
	POP P,SUBY
	POP P,SUBX
	POP P,LENFLD
	POP P,C
	POP P,CURFLD
	POP P,INT.A

	POP P,PRM		;RESTORE MY VARIABLES
	POP P,COLFLD		;[46]
	POP P,LINFLD		;[46]
	DMOVE A,LINFLD		;GET POSITION OF THIS FIELD
	CALL $POSIT		;POSITION TO IT.
	MOVE A,(P)		;GET THE CHARACTER
;[64]
	CALL $SCHAR		;[64]OUTPUT THE CHARACTER
	CALL $SEND		;[64]AND MAKE SURE ITS THERE
	MOVE B,LENFLD		;[125] RESTORE LENGTH OF FIELD
	SUBI B,1		;[125] LESS FIRST CHAR
	CALL SETLEN		;[125] AFTER RE-INITIALIZING
	POP P,A			;RESTORE THE CHARACTER
	RET			;AND CONTINUE NORMALLY.

;************************************************
;
;[15] --- END OF TEXTI. SIMULATION
;
;************************************************
;[112] ADD ROUTINES FOR 128 CHARACTER BREAK SET USAGE AFTER TEXTI. SIMULATION

SETTYP:			;[112] TELL MONITOR ABOUT THE TYPE OF FIELD HERE
	SKIPN	BRK128		;[112] IF NOT USING THE BREAK SET
	 RET			;[112]  THEN RETURN
	MOVEI	A,.PRIIN	;[112] USING THE CONNECTED TTY
	MOVX	B,.MOSBM	;[124] [112] SET THE BREAK SET
	MOVE	C,MSKIDX	;[112] INDEX INTO MSKTAB DISPATCH
	MOVE	C,MSKTAB(C)	;[112] GET ADDRESS OF ARGUMENT BLOCK
	MTOPR			;[112] SET IT
	 ERJMP	[SETZM	BRK128	;[112] NOT A RELEASE 4 SYSTEM
		 RET]		;[112]  SO NEVER CONSIDER IT AGAIN
	RET			;[112]

SETLEN:			;[112] TELL MONITOR THE LENGTH OF THE FIELD
	SKIPN	BRK128		;[112] IF NOT USING THE BREAK SET
	 RET			;[112]  THEN SIMPLY RETURN
	MOVEI	A,.PRIIN	;[112] USING THE CONNECTED TTY
	MOVE	C,B		;[112] SAVE THE FIELD LENGTH
	MOVX	B,.MOSFW	;[112] SET FIELD WIDTH
	MTOPR			;[112] SET IT
	 ERJMP	[SETZM	BRK128	;[112] IT FAILED, SO NEVER
		 RET]		;[112] CONSIDER IT AGAIN
	RET			;[112]
;
; VT52 TERMINAL SPECIFIC OPERATIONS
;
;

;[36] IS AN EDIT WHICH IS COMPLEMENTARY TO THE REMOVAL OF THE
;[36] TEXTI JSYS.



$RDCHAR:	PBIN		;READ THE CHARACTER
		CAIN A,RUBOUT	;[106]IF THIS IS A RUBOUT
		 MOVEI A,BACKSP ;[106]  THEN MAKE IT A BACKSPACE.
		RET		;RETURN WITH CHAR IN 'A'.

$CLIBF:		MOVEI A,.PRIIN	;CLEAR THE TERMINAL INPUT
		CFIBF		; BUFFER.
		RET


ECOON:
	MOVEI	A,.PRIIN
	RFMOD
	TXO	B,TT%ECO
	SFMOD
	RET

ECOOFF:
	MOVEI	A,.PRIIN
	RFMOD
	TXZ	B,TT%ECO
	SFMOD
	RET


$TTCHK:		;[55] CHECK THE STATUS OF THE TERMINAL ON EACH CALL
	SKIPN TTOPN		;[55]IF TERMINAL IS NOT OPEN DO IT.
	 CALL $TTOPN		;[55]
	CALL $TTSET		;[43]AT ANY RATE, RESET THEM.
	RET			;[55]RETURN TO CALLER.

$TTOPN:
	SKIPE TTOPN		;IF TTY IS OPEN
	 RET			;  THEN FORGET IT.
	MOVEI	A,.PRIOU
	RFMOD
	MOVEM B,OLDMOD
	RFCOC			;[55]GET CONTROL CHARACTER BITS
	DMOVEM B,COC		;[55]  AND SAVE THEM.
	CALL $TTSET		;[43]SETUP THE TERMINAL CHARACTERISTICS.
	SETOM TTOPN		;[55]INDICATE TERMINAL NOT OPEN.
	RET

$TTSET:		;[43]SET THE TERMINAL MODES
	SKIPE DORESET		;[72]IF FORCED RESET, DO IT.
	 CALL $TTRST		;[72]BUT IF IT HAS, MAKE SURE TO RESET.
	CALL	DOATI 		;TURN ON THE INTERRUPT SYSTEM
	MOVEI A,.PRIOU	;[43] USE PRIMARY JFN
	MOVE B,NEWMOD	;[43]  AND NEW MODE BITS
	SKIPE OLDLC	;[61]IF LOWER CASE IS BEING ALLOWED
	 MOVE B,NLCMOD	;[61]   THEN DO NOT TRANSLATE
	STPAR		;[43]   TO SET THE PROPER CONTROLS
	SFMOD		;[43]
	DMOVE B,$.BYTE	;[43]ALSO INSURE CONTROL CHARS ARE NOT
	SFCOC		;[43]  ECHOED.
	RET		;[43]

DOATI: 	
	SKIPE INTSET		;ARE INTERRUPTS SETUP ?
	 RET			;YES
	MOVEI A,.FHSLF		;[72]NORMALLY INHIBET CONTROL/C
	RPCAP			;[72] TRAPPING UNLESS SPECIFIED
	TXZ C,SC%CTC		;[72]INITIALIZE IT TO OFF
	SKIPE OLDCC		;[72]IF WE WANT CONTROL/C TRAPPING
	 TXO C,SC%CTC		;[72] THEN LABEL IT ON.
	EPCAP			;[72]AND SET THE CAPABILITY.

	MOVSI A,.TICCC		;[72]INDICATE CONTROL-C TRAPPING
	 ATI			;[72] THEN TRAP THE INTERRUPT.
	 ERJMP .+1		;[72] BUT ALLOW TO WORK IF HE/SHE HASN'T
	MOVSI A,.TICCO		;CONTROL/O
	ATI
	MOVSI A,.TICRB		;RUBOUT
	SKIPN OLDRB		;[106]IF RUBOUT TO BE TRAPPED, 
	 ATI			;[106]  THEN SET THE INTERRUPT.
	MOVSI A,.TICCR		;CONTROL/R
	ATI	;;DEBUG
	MOVSI A,.TICCT		;CONTROL/T
	ATI
	MOVSI A,.TICCU		;CONTROL/U
	ATI
	MOVSI A,.TICCV		;CONTROL/V
	ATI
	MOVSI A,.TICCW		;CONTROL/W
	ATI
	MOVSI A,.TICCS		;CONTROL/S
	SKIPN OLDCS		;[105]IF XON/XOFF NOT ALLOWED
	 ATI			;[105]  THEN SET INTERRUPT.
	MOVSI A,.TICCQ		;CONTROL/Q
	SKIPN OLDCS		;[105]IF XON/XOFF NOT ALLOWED
	 ATI			;[105]  THEN SET INTERRUPT.
;[36]	MOVE	A,[.TICTI,,1]
;[36]	ATI

REMARK	SET ALL INTERUPTS DEFERRED

	MOVE	A,[RT%DIM+.FHSLF]
	RTIW
;[36]	SETO	3,		;ALL TYPIN CHAR ARE DEFERRED
	HRLI	A,0
	STIW
	SETOM INTSET		;INDICATE INTERRUPTS ARE SET UP.
	SETZM DORESET		;[72]NO NEED TO FORCE RESET.
	RET




$TTRST:		;[62]RESET THE TERMINAL MODES

	SKIPN TTOPN		;IF THE TERMINAL IS NOT OPEN
	 RET			;  THEN NO NEED TO RESET.
	MOVEI A,.PRIOU
	MOVE B,OLDMOD		;RESTORE OLD MODE WORD
	STPAR
	SFMOD
	DMOVE B,COC		;RESTORE THE OLD CHARACTERISTICS
	SFCOC
	SKIPN INTSET		;IF INTERRUPTS ARE NOT SET
	 RET			; THEN NOTHING TO DO.
		;REMOVE THE INTERRUPT CHARACTERS
	MOVEI A,.TICCC		;[72]CONTROL/C
	DTI			;[72]
	 ERJMP .+1		;[72]PREPARE FOR THE WORST.
	MOVEI A,.TICCO		;CNTRL/O
	DTI
	MOVEI A,.TICRB		;RUBOUT
	DTI
	MOVEI A,.TICCR		;CNTRL/R
	DTI	;;DEBUG
	MOVEI A,.TICCT		;CNTRL/T
	DTI
	MOVEI A,.TICCU		;CNTRL/U
	DTI
	MOVEI A,.TICCV		;CNTRL/V
	DTI
	MOVEI A,.TICCW		;CNTRL/W
	DTI
	MOVEI A,.TICCS		;CNTRL/S
	DTI
	MOVEI A,.TICCQ		;CNTRL/Q
	DTI

	SETZM INTSET		;CLEAR INTERRUPT SET FLAG.
	RET
		;;[62] END OF RESET 
$ERASE:
	HRROI	A,[BYTE (7)33,"K",0,0,0]
	JRST	PUTOUT

$POSIT:
		ADDI A," "-1		;CREATE LINE NUMBER.
		ADDI B," "-1		;CREATE COLUMN NUMBER.
		PUSH P,A		;SAVE LINE NUMBER
		MOVEI A,33		;SEND OUT THE ESCAPE
		CALL $SCHAR		; AND SEND OUT THE ESCAPE.
		MOVEI A,"Y"		;DIRECT ADDRESSING COMMAND
		CALL $SCHAR		;
		POP P,A			;RESTORE THE LINE NUMBER
		CALL $SCHAR		; AND SEND IT OUT
		MOVEI A,(B)		;RESTORE THE COLUMN NUMBER
		CALL $SCHAR		; AND SEND IT OUT.
		RET			;RETURN

PUTOUT:
	CALL $SASCIZ		;[64]SEND OUT ASCIZ STRING
	RET

$CLEAR:
	HRROI	A,[BYTE (7)33,"H",33,"J",0]
	JRST	PUTOUT

$HOME:
	HRROI	A,[BYTE (7)33,"H",0,0,0]
	JRST	PUTOUT

$TTCLS:
	CALL	$CLEAR		;CLEAR TERMINAL FIRST
	CALL $SEND		;[64]MAKE SURE BUFFER IS OUT
	CALL	$TTRST		;RESET THE TERMINAL
	SETZM TTOPN		;CLEAR OPEN FLAG
	RET

$.BYTE:
	Byte(2)0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	Byte(2)0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0
;[36] NEWMOD:	TT%LCA+TT%WKF+TT%WKN+TT%WKP+3B29+TT%WKA+TT%ECO+TT%PGM
NEWMOD:	TT%LCA+TT%WKF+TT%WKN+TT%WKP+3B29+TT%WKA+TT%ECO+TT%PGM+TT%LIC
NLCMOD:	TT%LCA+TT%WKF+TT%WKN+TT%WKP+3B29+TT%WKA+TT%ECO+TT%PGM

	PAGE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;  TERMINAL OUTPUT ROUTINES -- DEFINED WITH EDIT [64]
;
; $SBEGIN -- INITIALIZE OUTPUT BUFFER (NO AC'S)
; $SEND   -- SEND OUTPUT BUFFER AND INITIALIZE (NO AC'S)
; $SCHKPNT-- SEND OUT BUFFER IF NEARING FULL STATUS
; $SCHAR  -- PUT ONE CHARACTER IN OUTPUT BUFFER
; $SMCHAR -- PUT CHAR IN 'A' INTO OUTPUT BUFFER 'C' TIMES
; $SSTRING-- POINTER IN 'B', LENGTH IN 'C'.
; $SASCIZ -- SEND ASCIZ STRING WITH TERMINATING 0.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

$SBEGIN:	;INITIALIZE OUTPUT BUFFER
	SETZM $SNUM		;NOTHING IN BUFFER.
	MOVE A,$SBUFPNT		;INITIALIZED BUFFER POINTER
	MOVEM A,$SBPTR		;AND SET UP DYNAMIC ONE.
	RET

$SEND:		;SEND OUT THE BUFFER
	SKIPG A,$SNUM		;IF NOTHING TO SEND THEN
	 RET			; THEN DO NOT SEND IT.
	CAMLE A,MAXOUT		;IF THIS IS LONGEST OUTPUT STRING YET
	 MOVEM A,MAXOUT		;  THEN SAVE IT FOR STATISTICS.
	ADDM A,TOTOUT		;UPDATE OUTPUT TOTAL.
	AOS NUMOUT		;COUNT NUMBER OF OUTPUTS
	SETZ A,			;INDICATE END OF STRING
	IDPB A,$SBPTR		;  WITH NULL BYTE
	MOVE A,$SBUFPNT		;GET POINTER TO BUFFER.
	PSOUT			;SEND IT.
	CALL $SBEGIN		;RE-INITIALIZE
	RET

$SCHKPNT:	;SEND OUT BUFFER IF GETTING TOWARD END.
	PUSH P,A			;SAVE REGISTER
	MOVE A,$SNUM		;GET CHARACTERS IN BUFFER COUNT.
	CAIL A,$SBUFSND		;IF MORE THAN SPECIFIED AMOUNT
	 CALL $SEND		; THEN CALL SEND NOW.
	POP P,A			;RESTORE A.
	RET


$SCHAR:		;SEND THE CHARACTER IN 'A'
	SKIPG A			;IF NULL CHARACTER THEN
	 RET			; FORGET IT.
	IDPB A,$SBPTR		;DEPOSIT CHARACTER
	PUSH P,A		;BE VERY CONSERVATIVE ABOUT HAVING
	AOS A,$SNUM		;  TOO MANY CHARACTERS IN BUFFER
	CAIL A,$SBUFMAX		;   AND IF THEIR ARE
	 JRST [AOS OVRFLOW	;     THEN COUNT OVERFLOWS
	       CALL $SEND	;	   SEND OUT THE BUFFER
	       JRST .+1]	;	   AND CONTINUE.
	POP P,A
	RET

$SSTRING:	;SEND THE STRING IN 'B' WHICH IS C CHARACTERS LONG
	SKIPG C			;IF NO CHARACTERS IN STRING
	 RET			;  THEN PUT NONE IN BUFFER
	ILDB A,B		;GET NEXT CHARACTER
	CALL $SCHAR		;SEND ONE CHARACTER
	SOJG C,.-2		;SPIN UNTIL DONE.
	RET			; AND RETURN.

$SASCIZ:	;SEND OUT THE STRING IN 'A'
	PUSH P,B		;SAVE B
	MOVE B,A		; AND PUT THE POINTER THERE
	HLR A,A			;IF THE LEFT SIDE IS A -1
	CAMN A,[-1]		; THEN
	 HRLI B,(POINT 7,)	;BUILD GOOD BYTE POINTER
$SAS10:
	ILDB A,B		;GET THE NEXT BYTE
	JUMPE A,$SAS40		; AND JUMP IF NULL
	CALL $SCHAR		;DUMP IN THE CHARACTER
	JRST $SAS10		;SPIN UNTIL DONE
$SAS40: POP P,B			;RESTORE AND
	RET			;EXIT

$SMCHAR:	;SEND CHARACTER IN 'A' 'C' TIMES
	SKIPG C			;IF THERE ARE NO CHARACTERS
	 RET			; THEN QUIT
	CALL $SCHAR		;SEND OUT THE CHARACTER IN 'A'
	SOJG C,.-1		; SPIN UNTIL ALL DONE.
	RET			;RETURN
	SUBTTL	TFRCLR - CLEARS A FIELD, SECTION, OR FORM FROM SCREEN
	LBL 4

COMMENT	+
	CALL TFRCLR (FIELD-ID, ERR)
	RETURN      (ERR)
	+

TFRCLR:
ENTER	FRMCLR,2,0		;[7] ALLOW TWO OR ZERO
	CALL $SBEGIN		;[64]RESET THE OUTPUT BUFFER.
	SETZM	ALLCLR
	CALL $TTOPN		;MAKE SURE TERMINAL IS OPEN
	HLRZ	A,-1(ARG)	;GET ARG COUNT
	JUMPN	A,%4.1		;MORE THAN ZERO - JUMP
	SETOM	ALLCLR
	SETZ	INT.A,
	SKIPN	DATJFN		;ANY FORMS INITED YET ?
	JRST	%4.12		;NO - JUST CLEAR SCREEN
	JRST	%4.2

%4.1:	MOVEI	INT.A,@0(ARG)	;GET W.S. POINTER
	HRRZ	INT.B,1(INT.A)
	SKIPN INT.A,0(INT.A)	;IF USER SPECIFIED, 'CLEAR FORM',
	 SETOM ALLCLR		; THEN SET FLAG TO CLEAR SCREEN.
	SETZM @1(ARG)		;[17]INDICATE VALID ERROR RETURN.

%4.2:	CALL	FIND		;SETUP NEXT FIELD.
	 JRST	%4.8		;NOT FOUND = ERROR
	 JRST	%4.9		;NO MORE = DONE
	 JFCL

	TXNE	PRM,%DSPLY	;ON SCREEN
	 JRST	%4.4		;YES
	SKIPE	ALLCLR		;NO--CLEAR EVERYTHING?
	 JRST	%4.2
	 JRST	%4.10

%4.4:
	SKIPN INT.A		;IF CLEARING THE WHOLE SCREEN
	 JRST %4.7		; THEN JUST MARK EACH FIELD.
	LOAD A,.FILLR		; ELSE 
	SKIPE A			;  IF THE FILLER IS NOT A BLANK
	 JRST [CALL ABLANK	;    THEN BLANK WHOLE THING
	       JRST %4.7]	;         AND MARK THE FIELD
	CALL BLANK		;    ELSE BLANK ONLY UNSPACED CHARACTERS.
	CALL $SCHKPNT		;[64]WRITE OUT TERMINAL BUFFER IF NECESSARY.
%4.7:	TXZ	PRM,%DSPLY	;INDICATE FIELD NOT ON SCREEN.
	CALL	STRPRM		;PUT PRM BACK
	JRST	%4.2		;GO FOR NEXT FIELD


%4.8:	MOVEI A,ERR.NF		;FIELD NOT FOUND ERROR.
	MOVEM	A,@1(ARG)
	RET

%4.9:		;NORMAL EXIT
	JUMPE INT.A,%4.11	;JUMP IF NO ARGUMENT OR FORM SPECIFIED.
;[41]	CALL	$HOME
	CALL $SEND		;[64]CLEAR THE OUTPUT BUFFER
	RET

%4.10:	MOVEI A,ERR.ND		;FIELD NOT DISPLAYED ERROR.
	MOVEM	A,@1(ARG)	;NOT DISPLAYED FIELD ERROR
	JRST %4.2		;[17] CONTINUE TILL REQUEST EXHAUSTED.
;[17]	RET

		;RESET TTY MODE WORD IF FORM CLEAR
%4.11:
	HLRZ A,-1(ARG)		;CLEARING WHOLE SCREEN.
	JUMPE A,%4.12		;IF USER SPECIFIED 'FORM', 
	CALL $CLEAR		; THEN CLEAR THE SCREEN AND
	CALL $SEND		;     FORCE CLEAR OUT
	RET			;      RETURN TO CALLER
%4.12:				; ELSE
	CALL	$TTCLS		;      CLEAR SCREEN AND CLOSE TERMINAL.
	RET
	SUBTTL CLRERR -- CLEAR ERROR LINE
	LBL 13

CLRERR:
	MOVE A,ERRLIN		;LOCATION OF ERROR LINE FOR FORM.
	MOVEI B,1		;STARTING AT FIRST POSITION
	CALL $POSIT		;POSTION TO LINE AND COLUMN
	CALL $ERASE		; AND ERASE THE  LINE.
	RET			;RETURN TO CALLER
	SUBTTL	TFRERR - USER GENERATED ERROR MESSAGES

TFRERR:
ENTER	FRMERR,3		;[7]
	SETZM	CURERR		;NO ERRORS YET
	SETZM	@2(ARG)		;ERROR RET
	CALL $SBEGIN		;[64]INITIALIZE TERMINAL OUTPUT BUFFER
	MOVE	A,CURFLD	;SAVE FOR LATER
	PUSH	P,A
	MOVEI	INT.A,@1(ARG)	;GET W.S. POINTER
	HRRZ	INT.B,1(INT.A)
	MOVE	INT.A,0(INT.A)
	PUSH	P,INT.A		;SAVE
	SKIPLE	INT.A
	CALL	INITAL
	POP	P,INT.A		;RESTORE
	POP	P,A		;&CURFLD
	MOVEM	A,CURFLD
	MOVE	A,CURERR
	JUMPE	A,%FE.1		;NO ERROR
	MOVEM	A,@2(ARG)
;[56]	RET
%FE.1:
	MOVEI B,@0(ARG)		;[70]GET THE ADDRESS OF ERROR MESSAGE
	MOVE A,0(B)		;[70]  BYTE POINTER AND
	HRRZ B,1(B)		;[70]    ITS LENGTH
	PUSH P,A		;[70]SAVE THE BYTE POINTER
	CALL TRNCBL		;[70]AND THEN FIND LAST NON-BLANK.
	MOVEI A,(B)		;[70]GET LENGTH.
	POP P,B			;[70]RESTORE BYTE POINTER TO 'B'
	MOVEI D,(A)		;[70] AND USE LENGTH RETURNED FROM TRNCBL
	MOVE E,[POINT 7,INTBUF]	;[70]  IN ORDER TO MOVE THE SIGNFICANT
	EXTEND A,[MOVSLJ]	;[70]  CHARACTERS TO INTBUF.
	 JFCL			;[70]
	SETZ A,			;[70]STORE A NULL BYTE AT THE
	IDPB A,E		;[70]  END IN ORDER TO MAKE ASCIZ STRING
	HRROI C,INTBUF		;[70]  STARTING AT INTBUF WHICH IS
	CALL PUTMSG		;[70]  TO BE PUT ON ERROR LINE
	CALL $SEND		;[70] FORCE THE MESSAGE OUT.
	RET			;[70].

INTERR:				;INTERNAL CALL TO ERROR
	CALL	PUTMSG
;[26]	SKIPE	DEFALT		;NO REPOSIT IF DEFAULTING
;[26]	JRST	CLRBF
	MOVE	A,LINFLD
	MOVE	B,COLFLD
	ADD	B,INT.C
;**;[113] CHANGE @ INTERR+7L	DSB	JAN 22,1979
;**;[113] INTERCHANGE THE FOLLOWING TWO INSTRUCTIONS
	SUB	B,TXTTAB+.RDDBC	;[113]FORM NEW POSITION
	MOVEM B,INTCOL		;[113][100]FLAG THAT WE ARE OFF THE SCREEN.
	CALL	$POSIT
	CALL $SEND		;[64]INSURE MESSAGE IS OUTPUT
	CALL $CLIBF		;CLEAR TERMINAL INPUT BUFFER.
	SETZM	DEFALT		;CLEAR DEFAULTING
	RET

PUTMSG:
	MOVEI	A,7		;BELL
	CALL $SCHAR		;[64]SEND ONE CHARACTER
	CALL	CLRERR		;CLEAR ERROR LINE
	MOVE	A,ERRLIN
	MOVEI	B,1
	CALL $POSIT
	MOVE	A,C		;DISPLAY MSG
	CALL $SASCIZ		;[64]SEND ASCII STRING
	SETOM	ERRDSP		;SAY ERROR IS ON SCREEN
	SKIPN	B,ERRRNG	;OUTPUT RANGE IF NEEDED
	RET
	MOVEI	A,""""
	CALL $SCHAR		;[64]SEND THE CHARACTER OUT.
	MOVE	A,B
	CALL $SASCIZ		;[64]SEND ASCII STRING
	MOVEI	A,""""
	CALL $SCHAR		;[64]SEND THE CHARACTER OUT.
	SETZM	ERRRNG
	RET
	SUBTTL	TFRCHG - CHANGE ATTRIBUTES OF FIELDS

	LBL	10
TFRCHG:
FRMCHG::
	.CALL.			;[63]ALLOW COBOL 'CALL' VERBS.

	HLRE	D,-1(ARG)	;GET AND SAVE ARGUMENTS FROM CALLER.
	MOVN	D,D
	CAIGE	D,3		;IF NOT AT LEAST 3 ARGUMENTS
	 RET			;  THEN RETURN TO CALLER.

	MOVEI	INT.B,@0(ARG)	;SET UP POINTERS TO ATTRIBUTE/FIELD-ID PAIR.
	MOVE	INT.A,0(INT.B)
	HRRZ	INT.B,1(INT.B)	;LENGTH OF FIELD-ID

%10.3A:	MOVE	E,ARG		;ARG = PTR TO ATTRIB - 1
	MOVE	C,D
	SUBI	C,2

	PUSH	P,D		;FIND THE CORRECT FIELD.
	PUSH	P,E
	PUSH	P,C
	CALL	FIND		;FIND IT
	 JRST	%10.9		;NOT THERE.
	 JRST	%10.10	;DONE
	 JFCL

	POP	P,C
	POP	P,E
	POP	P,D

%10.5:	SOJL	C,%10.3A	;IF NO MORE ATTRIBUTES THEN LOOP
	AOS	B,E
	PUSH	P,E
	PUSH	P,D
	DMOVE	D,[130
		   POINT 7,INTBUF] ;MOVE TO INTBUF
	MOVE	B,0(B)		;PTR TO 2-WD BLOCK
	HRRZ	A,1(B)		;LENGTH
	MOVE	D,A		;LENGTH OF DEST
	MOVE	B,0(B)		;BYTE PTR
	CALL MOV6OR7		;MOVE DATA CONVERTING TO ASCII.
	SETZ	A,		;PUT NULL BYTE AT END OF STRING.
	IDPB	A,E
	POP	P,D
	POP	P,E
	MOVEI	A,CGTBL
	MOVE	B,[POINT 7,INTBUF]
	PUSH	P,C
	TBLUK			;DO TABLE SEARCH FOR ARGUMENT.
	POP	P,C
	TXNN	B,TL%EXM	;IF NOT FOUND
	 JRST	%10.11		;  THEN TRY NEXT ONE.
	HRRZ	A,(A)		;  ELSE GET ADDRESS OF PROPER ROUTINE.
	PUSHJ	P,(A)		;DISPATCH TO ROUTINE
	 CALL	STRPRM		;SAVE THE 'PRM' SETTINGS.
	JRST	%10.5

%10.9:	MOVEI A,ERR.NF		;FIELD WAS NOT FOUND ERROR.
	JRST	%10.R

%10.10:	SETZ A,			;GOOD RETURN.
	JRST	%10.R


%10.11:	MOVEI A,ERR.IA		;INVALID ATTRIBUTE ERROR.
	SETZM	CURFLD		;DON'T FORGET TO RESET - EARLY EXIT (FIND)
	JRST	%10.RN

%10.R:	POP	P,C		;RESTORE SAVED
	POP	P,E		; REGISTERS.
	POP	P,D
%10.RN:	SOJ	D,		;ONE LESS ARG
	ADDI	D,(ARG)
	MOVEM	A,@(D)		;SET ERR CODE
	RET
SUBTTL	CG---- ROUTINES FOR USE BY TFRCHG


CGAB:
	TXZ	PRM,CLASS%
	TXO	PRM,ALPHA%
	RET
CGAN:
;[13]	TXO	PRM,CLASS%
	TXZ	PRM,CLASS%		;[13]CLEAR THE ALPHA ONLY OR NUMERIC
					; ONLY BITS.
	RET
CGMD:
	TXZ	PRM,DUPE%
	TXO	PRM,MSDUP%
	CALL LD.NUMRD			;[45]IF THE FIELD ALREADY HAS
	SKIPE	A			;[45]  INFORMATION IN IT
	 TXO	PRM,PRDUP%		;[45]   THEN MARK 'MASTER SET'.
	RET
CGND:
	TXZ	PRM,DUPE%
	RET
CGN:
	TXZ	PRM,CLASS%
	TXO	PRM,NUMER%
	RET
CGO:
	TXZ	PRM,FULL%+REQD%
	RET
CGPD:
	TXZ	PRM,DUPE%
	TXO	PRM,PRDUP%
	RET
CGP:
	TXO	PRM,PROT%
	RET
CGR:
	TXO	PRM,REQD%
	RET
CGUP:
	TXZ	PRM,PROT%
	RET
CGLR:
	AOS	B,E		;NEXT ATTRIBUTE
	SOSGE	C		;ONE LESS AROUND
	 PJRST	SKPRET		;BOMB IF NONE LEFT
	PUSH	P,C
	PUSH	P,D
	PUSH	P,E
	MOVE	B,(B)		;GET PTR & LENGTH
	HRRZ	A,1(B)		;LENGTH
	ANDI	A,37		;[12]LEAVE ONLY THE LENGTH BITS
	TXZ PRM,RANGL%		;[31]TURN OFF LOWER RANGE CHKING.
	JUMPE A,CGREX		;[31]IF NULL LENGTH, THEN NO RANGE CHK.
	MOVE	B,(B)		;PTR
	CALL	CGRGMV		;MOVE TO INTBUF
	MOVE B,[POINT 7,INTBUF]	;[31]IF LOW VALUES
	ILDB C,B		;[31]  THEN LOWER RANGE CHKING OFF.
	JUMPE C,CGREX		;[31]
	LOAD	E,.LRANG,0	;DEST
	SUB E,V11SYM		;[35]OFFSET TO THE PROPER
	ADD E,V12SYM		;[35]  PAGE.
	HRLI	E,(POINT 7,0)
	MOVE	D,LENFLD	;&LENGTH
	TXO	PRM,RANGL%	;SET RANGE INDICATOR
	PJRST	CGRGCM		;MOVE TO DESTINATION IN CORE
CGUR:
	AOS	B,E		;NEXT ATTRIBUTE
	SOSGE	C		;ONE LESS AROUND
	 PJRST	SKPRET		;BOMB IF NONE LEFT
	PUSH	P,C
	PUSH	P,D
	PUSH	P,E
	MOVE	B,(B)		;GET PTR & LENGTH
	HRRZ	A,1(B)		;LENGTH
	ANDI	A,37		;[12]LEAVE ONLY THE LENGTH BITS
	TXZ PRM,RANGU%		;[31]TURN OFF UPPER RANGE CHK.
	JUMPE A,CGREX		;[31]LEAVE OFF IF NULL INPUT.
	MOVE	B,(B)		;PTR
	CALL	CGRGMV		;MOVE TO INTBUF
	MOVE B,[POINT 7,INTBUF]	;[31]IF USER SPECIFIED FIELD
	ILDB C,B		;[31] OF LOW VALUES (ASCII 0),
	JUMPE C,CGREX		;[31]  THEN RETURN TO USER.
	LOAD	E,.URANG,0	;DEST
	SUB E,V11SYM		;[35] OFFSET TO THE PROPER
	ADD E,V12SYM		;[35]  PAGE.
	HRLI	E,(POINT 7,0)
	MOVE	D,LENFLD	;&LENGTH
	TXO	PRM,RANGU%	;SET RANGE INDICATOR
	PJRST	CGRGCM		;MOVE TO DESTINATION IN CORE
CGRGMV:				;MOVE TO INTBUF D-6 OR D-7
;**;[116] INSERT @ CGRGMV+1L	BPK	14-SEP-79
	SETZM	INTBUF		;[116] INITIALIZE TO LOW VALUES
	TXNN	PRM,NUMER%	;SKIP IF NUMERIC
	 JRST	[MOVE  SIX27	;MODIFY TABLE
		 TLZ   100000
		 MOVEM SIX27
		 JRST  .+1]
	PUSH	P,A		;SAVE OLD LENGTH
	MOVE	D,A
	MOVE	E,[POINT 7,INTBUF] ;DESTINATION
	CALL MOV6OR7		;MOVE CONVERTING TO ASCII.
	POP	P,B		;OLD LENGTH
	HRLI	A,0
	SUBM	B,A		;LENGTH MOVED
	TXNN	PRM,NUMER%	;RESTORE TABLE IF NOT NUMER
	 PJRST	[MOVE  SIX27
		TLO    100000
		MOVEM SIX27
		RET]
	RET

CGRGCM:				;MOVE INTBUF TO DESTINATION & PAD
	MOVE	B,[POINT 7,INTBUF]
	TXNN	PRM,NUMER%	;NUMERIC ?
	 JRST	CGCMAL		;NO
	PUSH P,E		;[31] SAVE THE POINTER TO THE RANGE
	EXTEND	A,[MOVSRJ
		   "0"]		;ZERO FILL
	JFCL
	POP P,E			;[31] RESTORE THE POINTER.
	MOVEI Z,"0"		;[31]INDICATE NON-BLANK SCANNING.
	PUSH P,VALFLD		;[31]SAVE CURRENT VALUE POINTER
	MOVEM E,VALFLD		;[31] AND POINT TO RANGE FIELD.
	CALL REPZER		;[31]PUT IN STANDARD FORM.
	POP P,VALFLD		;[31]RESTORE VALUE FIELD.
	JRST CGREX		;[31]EXIT.
CGCMAL:
	EXTEND	A,[MOVSLJ
		   " "]		;SPACE FILL A/N
	JFCL
	JRST	CGREX

CGREX:
	POP	P,E
	POP	P,D
	POP	P,C
;[12]	PJRST	SKPRET
	RET				;[12] RETURN AND UPDATE PRM.
;[43] START OF NEW CALL FOR RESETING TERMINAL CHARACTERISTICS
	SUBTTL TFRSET -- SET THE ATTRIBUTES OF THE TERMINAL

COMMENT ^
	THIS ROUTINE IS NECESSARY AFTER CALLING A LOWER FORK OR
	AFTER USING A DISPLAY TO THE TERMINAL.

	THERE ARE NO ARGUMENTS.
^

TFRSET::
	.CALL.			;[63]ALLOW COBOL 'CALL' VERBS.
	CALL $TTCHK		;RESET THE TRAFFIC TERMINAL CHARACTERISTICS
	RET			;RETURN TO CALLER.

	SUBTTL TFRRST -- RESET TERMINAL CHARACTERISTICS FOR THE USER

		;THIS WILL ALLOW USAGE OF CONTROL CHARACTERS, TFRSET
		; OR DEFAULT STARTUP SHOULD BE CALLED WHEN TRAFFIC
		; CONTROL IS NEEDED AGAIN
TFRRST::
	.CALL.			;[63]ALLOW COBOL 'CALL' VERBS.
	CALL $TTRST		;RESET THE TERMINAL CHARACTERISTICS
	RET

	PAGE

	SUBTTL TFRRWT -- RE-WRITE THE SCREEN

; THIS IS SIMILAR TO USING THE BLACK KEY TO CAUSE THE CURRENT
;  CONTENTS OF THE SCREEN TO BE REWRITTEN
;
; IT IS MOST USEFUL AFTER A CALL TO  IPRUNI TO RUN A LOWER FORK.
;
; THERE ARE NO ARGUMENTS
;

TFRRWT::
	.CALL.			;[63]ALLOW COBOL 'CALL' VERBS.

	SKIPE OLDTT		;[43]IF WE NEED TO SET CHARACTERISTICS
	  CALL $TTCHK		;[44]  THEN DO IT.
	CALL $SBEGIN		;[64]INSURE TERMINAL BUFFER FLUSHED.
	SETZB	INT.A,CURFLD
	CALL	$CLEAR		;CLEAR ALL OF SCREEN
RWT.RF:				;RWT.R LOOP
	CALL	FIND
	 JRST RWT.RG		;NOT-FOUND.
	 JRST RWT.RG		; RESTORE REGISTERS.
	 JFCL			;[24]FOUND IT.

	TXNN	PRM,%DSPLY	;DO THOSE PREVIOUSLY ON SCREEN
	 JRST	RWT.RF
	CALL	WRITE
	CALL	FILL
	CALL $SCHKPNT		;[64]OUTPUT BUFFER IF GETTING FULL
	JRST	RWT.RF

RWT.RG:
	SETZM CURFLD
	CALL $SEND		;[64]MAKE SURE BUFFER IS OUTPUT
	RET
;[43] END OF NEW CALLS

	PAGE
;[44] START OF NEW CALL TO RETURN THE FIELD NUMBER BASED ON FIELD NAME.

;
;
; TFRFNO -- GIVEN A FIELD NAME IN SIXBIT OR ASCII, THIS ROUTINE WILL
;		RETURN THAT FIELDS INTERNAL NUMBER.  THIS NUMBER CAN
;		THEN BE USED IN FUTURE CALLS IN ORDER TO GAIN MORE
;		EFFICIENCY.

;   ENTER MACRO USING FIELD-NAME, FIELD-NUMBER, ERROR
;
;	FIELD-NAME -- DISPLAY-7 OR DISPLAY-6 NAME OF A FIELD AS
;		SPECIFIED IN CURRENTLY INITIALIZED FORM.
;
;	FIELD-NUMBER -- COMP ITEM FOR THE FIELD NUMBER TO BE RETURNED.
;
;	ERROR -- COMP ITEM FOR THE ERROR RETURN.
;


TFRFNO::
ENTER FRMFNO,3
	MOVEI INT.A,@(ARG)		;GET THE POINTER TO THE
	HRRZ INT.B,1(INT.A)		; TO THE LENGTH
	MOVE INT.A,0(INT.A)		; AND ITS FIELD-NAME.

	JUMPE INT.A,FNO90		;IF FORM,
	HLRE A,INT.A			; OR
	JUMPE A,FNO90			;   FIELD-NUMBER
	AOJE A,FNO90			; OR SECTION NUMBER THEN ERROR.
					;OTHERWISE ITS A STRING POINTER.

	CALL FIND			;FIND THIS FIELD
	  JRST FNO95			;FIELD NOT FOUND.
	  JRST FNO95			;NO MORE FIELDS
	  JFCL				;GOT THE FIELD
	MOVE A,CURFLD			;GET THIS FIELD NUMBER
	MOVEM A,@1(ARG)			;RETURN IT FOR USER
	SETZM @2(ARG)			;INDICATE NO ERROR
	SETZM CURFLD			;CLEAR FIRST FIELD INDICATOR
	RET				;RETURN TO CALLER.

FNO90:
	MOVEI A,ERR.BA			;BAD ARGUMENT IN CALL
	JRST FNO99			;EXIT.
FNO95:
	MOVEI A,ERR.NF			;FIELD ID NOT FOUND
	SETZM CURFLD			;CLEAR FIELD INDICATOR
	JRST FNO99
FNO99:
	MOVEM A,@2(ARG)			;RETURN AN ERROR
	SETZM @1(ARG)			;CLEAR RETURNED VALUE
	RET				;RETURN TO CALLER.

	PAGE
;[53] BEGIN NEW SUBROUTINE CALL TO CHANGE SYSTEM VARIABLES.
	SUBTTL TFRSYS

;;;;;
;
; TFRSYS -- GIVEN A SYSTEM VARIABLE NUMBER, THIS ROUTINE WILL RETURN
;	ITS CURRENT VALUE AND UPDATE ITS VALUE TO THAT SPECIFIED BY
;	THE CALLER
;
;   ENTER MACRO TFRSYS VARIABLE#,NEW-VALUE,OLD-VALUE,ERROR.
;
;	ALL VARIABLES ARE COMPUTATIONAL.
;
;	 VARIABLE# ---  1 THRU 'N' FROM SYSTAB BELOW (OR NEGATIVE FOR
;			  FOR USER DEFINED VALUES)
;	 NEW-VALUE ---  0 OR -1 (TO SET OR RESET SYSTEM FLAG)
;	 OLD-VALUE ---  VALUE (0 OR -1) OF VARIABLE AT TIME OF CALL
;	 ERROR     ---  0 IF VALUE CHANGED, ERR.IV IF ILLEGAL VARIABLE#,
;			ERR.NV IF NEW VALUE NOT 0 OR -1.
;
;	THE DEFINITION OF EACH ARGUMENT IN THE SYSTAB TABLE IS:
;		0,,VARIABLE	OR
;	ROUTINE  ,,VARIABLE
;
;	WHERE THE ROUTINE IS CALLED AFTER THE VARIABLE IS SET TO 0, -1
;

	SYSUSR=SYSTAB-.		;NUMBER OF USER ARGUMENTS
				;IF AN INSTALLATION WANTS TO DEFINE ITS
				; OWN SYSTEM VARIABLE, THEN IT SHOULD
				; PUT THE VARIABLE TO BE REDEFINED BETWEEN
				; THE DEFINITION OF SYSUSR AND SYSTAB IN
				; ARE DEFINED AFTERWARDS.
	SYSTAB:	0
		OLDTT		;IF -1, THEN RESET TERMINAL CHARACTERISTICS
				;	ON EACH TRAFFIC CALL.
				;IF 0, THEN ONLY RESET THEM ON DEMAND (TFRSET).
		OLDRN		;IF 0, THEN REWRITE NUMERIC VALUES RIGHT JUSTIFIED.
				;IF -1, THEN DO NOT REWRITE THESE VALUES.

		OLDLC		;IF 0, THEN NO LOWERCASE, IF -1 THEN LC.

	SYS100,,OLDCC		;[104]IF 0, THEN NO CONTROL/C TRAPPING, IF
	SYS100,,OLDCS		;[105]IF 0, THEN XON/XOFF IGNORED
				;[105]IF-1, THEN XON/XOFF USED FOR CONTROL.
	SYS100,,OLDRB		;[106]IF 0, THEN RUBOUT IGNORED
				;[106]IF-1, THEN RUBOUT IS BACKSPACE.
				;[72]-1 THEN CONTROL/C TRAPPING.
;**; [112] INSERT BEFORE SYSMAX	CLRH	28-JUL-80
	BRK128			;[112] 0: 3A WAY, -1: 128 CHARACTER BREAK SET
	  SYSMAX=.-SYSTAB

TFRSYS::
	ENTER FRMSYS,4
	SETZM @3(ARG)			;INITIALIZE ERROR RETURN
	MOVE A,@(ARG)			;GET THE VARIABLE#
	JUMPL A,SYS80			;MAY BE USER VARIABLE
	JUMPE A,SYS90			;ILLEGAL VALUE.
	CAILE A,SYSMAX			;IF NOT LEGAL NUMBER
	 JRST SYS90			;  THEN INFORM USER.
SYS50:
	HRRZ C,SYSTAB(A)		;[104]GET ADDRESS OF VARIABLE
	MOVE B,(C)			;[104]GET CURRENT VALUE OF VARIABLE.
;[104]	MOVE B,@SYSTAB(A)		;GET CURRENT VALUE OF FIELD
	MOVEM B,@2(ARG)			;  AND STORE FOR CALLER.
	MOVE B,@1(ARG)			;GET NEW VALUE.
	CAME B,[-1]			;IF VALUE IS -1 OR
	 SKIPN B			;  0, THEN IT IS LEGAL
	  SKIPA				; ELSE
	   JRST SYS95			;   IT IS AN ERROR.
	MOVEM B,(C)			;[104]STORE NEW VALUE.
;[104]	MOVEM B,@SYSTAB(A)		;STORE THE NEW VALUE
	HLRZ C,SYSTAB(A)			;[104]GET THE ROUTINE TO CALL IF ANY
	SKIPE C				;[104] IF EMPTY THEN NO ROUTINE.
	 CALL (C)			;[104]ELSE CALL THE ROUTINE.
	RET				; AND RETURN TO CALLER.

SYS80:		;CHECK FOR LEGAL USER VARIABLE
	MOVN B,A			;GET MAGNITUDE OF VALUE
	CAIG B,SYSUSR			;IF WITHIN USER VARIABLE RANGE
	 JRST SYS50			;  THEN TREAT NORMALLY.
SYS90:
	MOVEI A,ERR.IV			;INVALID VARIABLE NUMBER
	JRST SYS99
SYS95:
	MOVEI A,ERR.NV			;ARGUMENT NOT 0 OR -1.
SYS99:	MOVEM A,@3(ARG)			;STORE THE ERROR.
	RET

SYS100:	SETOM DORESET			;[104]MAKE SURE WE CHANGE SOMETHING.
	CALL $TTCHK			;[104] DURING CHECK.
	RET
;;;;;;;;;;;;;;;[53] END OF ADDITION;;;;;;;;
;[44] END OF EDIT
	SUBTTL	GETFIL - GET  AND OPEN INPUT DATA FILE

GETFIL:
	HRRZ	A,1(INT.A)
;**; [120] REMOVE TWO LINES AT GETFIL + 1	CLRH	26-FEB-80
;[120]	MOVE	B,0(INT.A)
;[120]	TLNN	B,100		;ASCII IN COBOL
;[120] NOW ALWAYS IN INTBUF
	MOVE	B,[POINT 7,INTBUF] ;NO - CONVERTED IN INTBUF
	DMOVE	D,[130	;LENGTH OF INT.BUF.
		   POINT 7,FRMFIL]
	EXTEND	A,[ MOVSLJ
		    " "]		;FILL WITH SPACES
	JRST	.GTF1		;FILE NAME TOO LONG
	SKIPN	A,DATJFN	;[6] SKIP IF FILE OPEN
	JRST	.GTF0		;[6] SKIP CLOSF IF NOT

	MOVE B,V12DAT		;[52]FREE THE DATA PAGES
;	MOVE B,V12DCO		;[54]REAL ADDRESS GOTTEN
	MOVE C,DATSIZ		;[52] BY SPECIFYING LOCATION
	CALL FREPAG		;[52] AND SIZE.

	MOVE B,V12SYM		;[52]THEN FREE THE SYMBOL PAGES
;	MOVE B,V12SCO		;[54]REAL ADDRESS GOTTEN
	MOVE C,SYMSIZ		;[52] BY SPECIFYING LOCATION
	CALL FREPAG		;[52] AND SIZE.

	HRRZ	A,DATJFN	;[6] CLOSE AND RELEAS
	CLOSF			;[6] OLD JFN (IGNORE ERRORS)
	CALL	.GTF2		;[6] INDICATE ERROR TO USER
.GTF0:				;[6] HERE TO SKIP CLOSF
	MOVE	A,[GJ%SHT+GJ%OLD]
	HRROI	B,FRMFIL	;NAME IN FRMFIL
	GTJFN
	RET			;ERROR
	MOVEM	A,DATJFN	;SAVE JFN
	MOVE	B,[36B5+OF%RD+OF%PLN]
	OPENF
	ERJMP	[RLJFN
		 JFCL
		 RET]
	AOS	(P)
	RET

.GTF1:	TMSG	<TFRCOB(GETFIL) FILENAME TOO LONG>
	RET			;ERROR

.GTF2:				;[6] INDICATE CLOSF FAILURE
	TMSG	<TFRCOB(GETFIL) CLOSF FAILED>
	RET
.GTF3:				;[6] PMAP FAILURE
	TMSG	<TFRCOB(GETFIL) PMAP FAILED>
	RET
	SUBTTL MAPIN -- MAP USER'S FORM FILE INTO  MEMORY

;[52] THE FOLLOWING ROUTINE REPLACED THE PREVIOUS ROUTINE WITH THIS EDIT.
;[52] IS DYNAMICALLY ACQUIRED AND FREED AS FORMS ARE CHANGED. THE ROUTINE
;[52] WILL WORK WITH THE MEMORY ALGORITHMS OF V12 COBOL OR VERSION 11.

MAPIN:
	SETZM	GOTFIL			;INDICATE NO FILE MAPPED YET.
	SETZM PAGINI			;INDICATE GOING FOR DATA PAGES.
	SETZ	A,			;START WITH PAGE-0 OF FORM FILE
	MOVEI C,1			; AND MAP ONLY THE FIRST PAGE.
	SETZM DATSIZ			;INITIALIZE TO NO PAGES.
	SETZM SYMSIZ
	CALL GETPAG			;GET MEMORY AND MAP PAGE.
	 RET				;ERROR RETURN--REASON IN 'A'.
;	MOVEM A,V12DCO			;[54]SAVE ACTUAL STARTING ADDRESS.
;	ADDI A,777			;[54]BUMP UP TO NEXT PAGE BOUNDRY.
;	ANDI A,777000			;[54]MAKE PAGE ALIGNED.
	MOVEM A,V12DAT			;SAVE ADDRESS OF PAGE.
	AOS DATSIZ			;INDICATE 1 PAGE.
	MOVE B,.DATPG			;BUILD THE BYTE POINTER
	SUB B,V11DAT			;  TO THE VARIABLE WHICH
	ADD B,V12DAT			;  HAS THE SIZE OF THE DATA AREA.
	LDB C,B				;GET THE SIZE OF THE DATA AREA.
	JUMPE C,MAPI50			;IF ONE PAGE, THEN WE HAVE GOT IT.
	PUSH P,C			; ELSE MORE THAN 1 PAGE SO
	MOVEI C,1			;    FREE THIS PAGE
	MOVE B,V12DAT			;    AND THEN
;	MOVE B,V12DCO			;[54]GET ACTUAL STARTING ADDRESSRESS.
	CALL FREPAG			;    
	POP P,C				;GET THE LENGTH OF DATA AREA
	AOS C
	SETZM DATSIZ			;INDICATE NO PAGES YET.
	SETZ A,				;  THEN GET A CONTIGUOUS AREA
	PUSH P,C			;NUMBER OF PAGES DESIRED SAVED.
	CALL GETPAG			;  OF THE PROPER SIZE.
	 JRST [POP P,C			;NO MORE PAGES AVAILABLE
	       RET]
	POP P,DATSIZ			;AND RESTORED TO DATA SIZE VARIABLE.
;	MOVEM A,V12DCO			;[54]SAVE THE ACTUAL ADDRESS
;	ADDI A,777			;[54]BUMP UP TO NEXT PAGE BOUNDRY.
;	ANDI A,777000			;[54]PAGE ALLIGNED.
	MOVEM A,V12DAT			;SAVE ADDRESS OF DATA AREA.

MAPI50:		;GET AREA FOR THE SYMBOL AREA
	SETOM PAGINI			;INDICATE SYMBOL AREA PAGES.
	MOVE A,DATSIZ			;SYMBOL AREA STARTS ON THIS PAGE
	MOVE B,.STRPG			; OF THE FILE. SIZE OF THE 
	SUB B,V11DAT			; SYMBOL AREA IS CONTAINED
	ADD B,V12DAT			; IN BYTE VARIABLE
	LDB C,B				; NOW IN 'C'.
	AOSG C				;IF ZERO, THEN NO
	 JRST SKPRET			; SYMBOLS WERE INVOLVED.
	PUSH P,C			;SAVE THE SIZE OF SYMBOL AREA.
	CALL GETPAG			;ELSE GET THE PAGES
	 RET				; UNLESS NOT AVAILABLE.
	POP P,SYMSIZ			;RESTORE SIZE OF SYMBOL AREA.
;	MOVEM A,V12SCO			;[54]SAVE ACTUAL ADDRESS.
;	ADDI A,777			;[54]BUMP UP TO NEXT PAGE BOUNDRY.
;	ANDI A,777000			;[54]MAKE PAGE ALIGNED.
	MOVEM A,V12SYM			;SAVE ADDRESS OF MEMORY AREA.
	SETOM GOTFIL			;INDICATE WE HAVE GOT IT.
	JRST SKPRET			;RETURN.

;;;;;;;;;;;;;;;;;;;;

GETPAG:		;ROUTINE TO GET MEMORY FROM COBOL MEMORY MANAGEMENT
		;ROUTINES AND MAP FORM FILE INTO IT.

		;CALL WITH:  A -- PAGE OF FILE TO START MAP.
		;	     B -- ANYTHING.
		;	     C -- NUMBER OF PAGES TO MAP.

		;RETURN WITH:A -- ADDRESS OF FIRST PAGE

		;ERROR RETURN WITH: A -- ERROR NUMBER.

		;ON CALL PAGINI=0 IF DATA AREA PAGES AND -1 IF
		;	SYMBOL AREA PAGES.

		;CALL:    CALL GETPAG
		;            ERROR RETURN WITH ERROR IN 'A'.
		;		GOOD RETURN.

	SKIPGE V11V12		;IF DEFINITELY VERSION 11 COBOL
	 JRST GETP75		;  THEN GO TO IT NOW.
	PUSH P,A		;SAVE THE REGISTERS WHILE GETTING THE
	PUSH P,C		;MEMORY.
	LSH C,PG2ADR		;TURN NUMBER OF PAGES TO NUMBER OF WORDS.
;	ADDI C,777		;[54]MAKE SURE WE GET ENOUGH UNALIGNED.
	MOVEM C,IMP%SZ		;SET UP THE ARGUMENT BLOCK
	SETZM IMP%ST		; FOR THE COBOL CALL.
	PUSH P,ARG		;SAVE ARGUMENT LIST POINTER.
	MOVEI ARG,ARG%GP	;LOAD POINTER TO ARGUMENT BLOCK.
	CALL FUNCT.##		;GET THE MEMORY.
	POP P,ARG
	POP P,C
	POP P,A
	SKIPE IMP%ST		;IF ERROR ON CALL
	 JRST GETP50		; THEN WE DID NOT GET THE MEMORY.
	SETZM V11V12		;INDICATE VERSION 12 OF COBOL.
GETP25:
	HRL A,DATJFN		; ELSE PREPARE TO MAP THE FILE.
	MOVE B,IMP%PT		;GET THE ADDRESS OF THE MEMORY
;	ADDI B,777		;[54]MAKE SURE WE GET TO PAGE BOUNDRY.
	LSH B,ADR2PG		; AND TURN INTO PAGE NUMBER.
	HRLI B,.FHSLF
	TXO C,<PM%CNT+PM%CPY%+PM%RD>
	PMAP
	 ERJMP GETP40		;ERROR ON PMAP.
	MOVE A,IMP%PT		;GET THE ADDRESS OF THE MEMORY
	JRST SKPRET		;AND RETURN.

GETP40:	MOVEI A,ERR.DP		;INDICATE PMAP FAILURE
	RET			; AND GIVE ERROR RETURN.
GETP50: SKIPG IMP%ST		;IF NEGATIVE
	 JRST GETP75		;  THEN CALL NOT LEGAL (VERSION 11).
	MOVEI A,ERR.NC		;  ELSE NO MEMORY AVAILABLE.
	RET

GETP75:	SETOM V11V12		;INDICATE DEFINITLY VERSION 11 COBOL.
		;;HERE WHEN RUNNING UNDER VERSION 11 COBOL.

	MOVEI B,HDRWRD		;...FOR NOW
	MOVEM B,IMP%PT		;SAVE IN V12 ARGUMENT BLOCK.
	SKIPL PAGINI		;IF WE ARE DEALING WITH THE DATA AREA
	 JRST GETP25		; THEN CONTINUE.
	MOVEI B,STRING		; ELSE USE THE SYMBOL PAGES.
	MOVEM B,IMP%PT
	JRST GETP25

;;;;;;;;;;;;;;;;;;;;;;;;;

FREPAG:
		;UNMAP THE PAGES FROM THE FORM FILE AND RETURN THEM
		; TO COBOL FREE POOL.

		;CALL WITH:  B -- ADDRESS OF MEMORY AREA
		;	     C -- LENGTH (IN PAGES) OF AREA.

	SKIPG C			;IF NO PAGES TO FREE
	 RET			; THEN WE ARE DONE.
	MOVEM B,IMP%PT		;PUT THE MEMORY ADDRESS IN FUNCT. ARG BLK.
	MOVE A,C		;AND AFTER CONVERTING
	LSH A,PG2ADR		; TO SIZE IN WORDS
;	ADDI A,777		;[54]WAS DONE ON 'GET' TO INSURE PAGE ALIGNMENT.
	MOVEM A,IMP%SZ		;  PUT THE SIZE IN FUNCT. ARG BLK.
	SETO A,			;INDICATE FREEING PAGES.
;	ADDI B,777		;[54]GETPAG WENT TO NEXT WHOLE PAGE.
	LSH B,ADR2PG		;CONVERT TO PAGE NUMBER.
	HRLI B,.FHSLF		;UNMAP FROM MY FORK.
	TXO C,<PM%CNT>		;COUNT IS IMPORTANT.
	PMAP
	 ERCAL FREP50		;PMAP ERROR.
	SKIPGE V11V12		;IF VERSION 11 IS RUNNING
	  RET			; THEN DO NOT RELEASE CORE.
	PUSH P,ARG		;SAVE THE ARGUMENT POINTER
	MOVEI ARG,ARG%FP	;FREE-PAGES ARGUMENT BLOCK.
	CALL FUNCT.##		;DO IT.
	POP P,ARG		;RESTORE ARGUMENT POINTER.
	RET			;RETURN TO CALLER.

FREP50: TMSG <TFRCOB (FREEPAGE) PMAP ERROR>
	RET
;[52] END OF EDIT TO DO DYNAMIC PAGE GATHERING/FREEING
	SUBTTL	SETERL - DETERMINE ERROR LINE NUMBER AND PUT IN REG. A

SETERL:
	PUSH P,B			;[35]
	MOVE B,.TRMS			;[35]
	SUB B,V11DAT			;[35]
	ADD B,V12DAT			;[35]
	LDB E,B				;[35]
	POP P,B				;[35]

	MOVEI	A,^D24		;DEFAULT TO LEAST RESTRICTIVE CASE
	TXNE	E,%%VT52
	MOVEI	A,^D24
	TXNE	E,%%VT05
	MOVEI	A,^D20
	TXNE	E,%%VT50
	MOVEI	A,^D12
	RET
	LIT
	SUBTTL  DATA AREA FOR TRAFFIC-20

;PURE DATA AREA (SMALL) BUT ALIVE.


$SBUFPTR: POINT 7,STRBUF	;[64]INITIALIZED POINTER TO BUFFER.
$SBUFMAX=^D300			;[64]300 CHARACTERS IN BUFFER
$SBUFSND=$SBUFMAX-^D80		;[64]SEND LESS THAN 80 CHARS IN BUFFER.
%FILES:	XWD -1,0		;[63] ALWAYS A 0.
DBYYBP:	POINT 14,DATBUF,14	;[16]BYTE POINTER FOR YEAR.
DBMMBP:	POINT 14,DATBUF,28	;[16]BYTE POINTER FOR MONTH.
DBDDBP:	POINT 14,DATBUF+1,14	;[16]BYTE POINTER FOR DAY.
TFRPAT:	BLOCK ^D64		;64 WORD PATCH AREA.




;	ARGUMENT BLOCK TO THE FUNCT. CALL IN LIBOL
;	FORMAT IS
;
;		-CNT,,0
;	LST:	TYPE,,FUNCTION
;		TYPE,,[ERROR]
;		TYPE,,[STATUS]
;		TYPE,,[ADDRESS OF CORE]
;		TYPE,,[SIZE]



	-4,,0
ARG%GP:	200,,GP.PAG		;GET PAGE ALLIGNED MEMORY
	200,,IMP%ER		;ERROR CODE
	200,,IMP%ST		;STATUS CODE
	200,,IMP%PT		;POINTER TO AREA
	200,,IMP%SZ		;SIZE TO BE GOTTEN


;[54]ONLY REMOVE THE ';[54]' ON NEXT LINE IF EDIT 54 IS REMOVED.
GP.PAG:	15			;CODE FOR GETTING PAGE ALIGNED DATA.
;GP.PAG:	6			;[54]CODE TO GET UNALIGNED DATA.

ARG%FP:	200,,FP.PAG		;GET PAGE ALLIGNED MEMORY
	200,,IMP%ER		;ERROR CODE
	200,,IMP%ST		;STATUS CODE
	200,,IMP%PT		;POINTER TO AREA
	200,,IMP%SZ		;SIZE TO BE GOTTEN


FP.PAG:	7			;CODE FOR FREEING PAGE ALIGNED DATA.



REMARK  CHARACTER TABLE FOR DEFINING CHARACTER CLASSES

;IMPURE DATA AREA

IFN	FT2SEG,<RELOC 0>	;RELOC TO LOW SEG IF REENT. CODE DESIRED

TFRDAT::			;START OF TFRCOB IMPURE DATA
SUBTAB:				;SUB-FIELD LENGTHS
	BYTE (7)2,2,2,0		;DT0, DDT4
	BYTE (7)2,3,2,0		;DT1, DT3
	BYTE (7)5,0		;DT2
	BYTE (7)3,2,4,0		;SSN
	BYTE (7)"$","C",0	;MONEY (MODIFIED)




CHRTAB:		;CHARACTER TABLE
	CONCHR=1
	FCCCHR=2
	PNCCHR=4
	NUMCHR=10
	ALPCHR=20

	REPEAT 8,<CONCHR>	;CONTROL/A THRU CONTROL/G
	REPEAT 3,<FCCCHR>	;BACKSPACE,TAB,LF
	REPEAT 1,<CONCHR>	;VT
	REPEAT 2,<FCCCHR>	;FF,CR
	REPEAT ^D17,<CONCHR>	;OTHERS
	REPEAT 1,<FCCCHR>	;37

	REPEAT ^D16,<PNCCHR>	;40-57
	REPEAT ^D10,<NUMCHR>	;60-71  0-9
	REPEAT ^D7,<PNCCHR>	;72-100
	REPEAT ^D26,<ALPCHR>	;101-132  A-Z
	REPEAT ^D6,<PNCCHR>	;133-137
	REPEAT ^D26,<ALPCHR>	;140-172  SMALL(A-Z)
	REPEAT ^D5,<PNCCHR>	;173-177


REMARK	TRANSLATION TABLES FOR SIX & SEVEN BIT TO SEVEN BIT TRANSLATION.

SVN27:				;ASCII TO ASCII MOVE
		XWD 100000,1
		.CHAR=2
REPEAT	<36/2>,< XWD .CHAR,.CHAR+1
		 .CHAR=.CHAR+2    >

SIX27:
REPEAT	     1,< XWD 100040,.CHAR+1
		 .CHAR=.CHAR+2    >
REPEAT	<<200-42>/2>,< XWD .CHAR,.CHAR+1
		       .CHAR=.CHAR+2>


;**; [120] INSERT BEFORE MAXFLD	CLRH	26-FEB-80
SVN2U:				;[120] ASCII TO UPPERCASE-ONLY ASCII
	XWD	100000,1	;[120] STOP ON NULL
	.CHAR=2			;[120[ SET UP FOR REPEAT
REPEAT <<140-2>/2>,<XWD .CHAR,.CHAR+1	;[120]
		    .CHAR=.CHAR+2>	;[120] GET THROUGH ASCII 140
	XWD	140,101		;[120] ASCII 140 AND LOWER-CASE A
	.CHAR=.CHAR+2		;[120]
REPEAT <^D24/2>,<XWD <.CHAR-40>,<.CHAR-37>	;[120]
		  .CHAR=.CHAR+2>	;[120] GET LOWER CASE (TO UPPER CASE)
	XWD	132,173		;[120] LOWER-CASE Z AND LEFT BRACKET
	XWD	174,175		;[120] VERTICAL BAR AND RIGHT BRACKET
	XWD	176,177		;[120] TILDE AND DELETE

MAXFLD:	0			;[71]HIGHEST FIELD REACHED BEFORE BACKUP
FLAG1:	0			;[71]STATE FLAG.
LASTFLD: 0			;[71]SAVE PREVIOUS FIELD NUMBER.
SECTAB:	BLOCK ^D30		;[67]SECTION TABLE
FLDTLN=^D31  ;[67]LENGTH (PRIME #) OF ENTRIES IN FIELD TABLE
FLDTAB:	BLOCK FLDTLN+2		;[67]FIELD TABLE

MOVFILL:  MOVSLJ		;[64]MOVE LEFT JUSTIFIED
	  0			;[64] KEEP WITH MOVFILL.
FILCHAR:	0		;FILLER CHARACTER FOR CURRENT FIELD.
TOTOUT:	0			;[64]TOTAL NUMBER OF CHARACTERS OUT
NUMOUT:	0			;[64]  AND NUMBER OF CALLS TO $SEND
MAXOUT: 0			;[64]LONGEST STRING SENT OUT
OVRFLOW: 0			;[64]COUNT OF NEAR BUFFER OVERFLOWS.
$SBPTR:	0			;[64]OUTPUT BUFFER BYTE POINTER
$SNUM:  0			;[64]NUMBER CHARS LEFT IN BUFFER
STRBUF: BLOCK $SBUFMAX/5+^D10	;[64]SIZE OF TERMINAL OUTPUT BUFFER WITH PADDING.
OLDMOD:	0			;[55]MOVE TO IMPURE STORAGE
COC:	BLOCK 2			;[36]
GOTFIL:	0			;[35]=0 IF NO FILE MAPPED, -1 OTHERWISE.
;**; [112] INSERT BEFORE OLDTT	CLRH	28-JUL-80
MSKIDX:	0			;[112] INDEX INTO MAXTAB
OLDTYP:	0			;[112] HOLDS OLD VALUE OF FILTYP
BRK128:	BRK%128			;[112] 0: 3A WAY, -1: USE 128 CHARACTER BREAK SET
OLDTT:	OLD%TT			;[43]=0 IF NOT SETTING CHARACTERISTICS
				;[43]  ON EACH CALL.
OLDCR:	OLD%CR			;[37]=0, CR=5, -1, CR=3
OLDAR:	OLD%AR			;[37]=0, LEFT/RIGHT ARROWS ARE BACKSP/TAB
				;[37]	IF -1, THEN END-INDICATOR OF 5.
OLDRQ:	OLD%RQ			;[37]=0, USE CURRENT CODE,-1 OLD CODE.
OLDZR:	OLD%ZR			;[37]
OLDMD:	OLD%MD			;[37]
OLDPR:	OLD%PR			;[37]
OLDRN:	OLD%RN			;[51]=0, THEN REWRITE NUMERIC FIELDS
OLDWR:	OLD%WR			;[60]=0,TFRWRT TO NONINITIALIZED FIELDS WORKS.
				;[60]=-1, TFRWRT TO NONINITIALIZED FIELDS FAILS.
OLDLC:	OLD%LC			;[61]=0, NO LOWERCASE, =-1, LOWERCASE
OLDCC:	OLD%CC			;[72]=0, NO CNTRL/C TRAP,=-1 THEN DOIT.
DORESET: 0			;[104]FORCE TERMINAL RESET FLAG.
OLDUD:	OLD%UD			;[37]=0,UP/DOWN ARROWS = CARRIAGE RET.
OLDCS:  OLD%CS			;[105]0,IGNORE XON/XOFF, -1, USE THEM
OLDRB:  OLD%RB			;[106]0,IGNORE RUBOUT, -1,IS BACKSPACE.
SYMSIZ:	0				;[35]STORAGE FOR SYMBOL AREA SIZE
DATSIZ: 0				;[35]STORAGE FOR DATA AREA SIZE.
V11V12:	COB%VR			;[35]0=V12,-1=V11,1=DYNAMIC
V12DCO:	0			;[54]USED TO HOLD REAL (UNALLIGNED) ADDRESS.
V12SCO: 0			;[54]USED TO HOLD REAL (UNALLIGNED) ADDRESS.
PAGINI: 0				;[35]FLAG IF STORAGE GOTTEN ONCE.
V11SYM: STRING			
V12SYM: 0
V11DAT: HDRWRD
V12DAT: 0
FRSTCHR:	0		;[25]SAVE FIRST CHAR OR FILLER.
FRSTSB:	0			;[27]FIRST SUBFIELD INDICATOR.
USRDAT:	BLOCK 2			;[16]SAVE AREA FOR USER DATE
DATBUF: BLOCK 2			;[16]CONONICAL DATE AREA.
FLDTYP: 0			;[15] BREAK SET STORAGE CELL.
ISNEG:  0			;[21]CELL USED FOR INDICATING NEGATIVE NUMBERS.
ISTAB:	0			;[15]SET IF PREVIOUS DUPE TABBED OVER.
PREDUP: 0			;[15] IF -1, THEN STARTING PREVIOUS
				;[15]  DUP FIELD.
COBCAL:	0			;CALL FROM COBOL
TTOPN:	0			;TT JFN IS SET
INTSET:	0			;TERMINAL INTERRUPTS NOT SET
DEFALT:	0			;SPECIAL DEFALT FROM TFRRD
ERRDSP:	0			;ERROR IS ON SCREEN
ALLCLR:	0			;CLEAR ALL ON SCREEN DATA IN PROGRESS

ERRRNG:	0			;ERROR LINE POINTER FOR RANGE STUFF
INTCOL:	0			;INTERUPT COLUMN
TRMCHR:	0			;TERMINAL CHARACTER ON A READ (FLDRD)
DATJFN:	0			;JFN OF FORM DATA FILE
RECPTR:	0			;POINTER TO USERS RECORD DESCRIPTION.
HIFLD:	0			;HIGHEST # FIELD THIS FORM.
CURERR:	0			;CURRENT ERROR CODE.
LENERR:	0			;LENGTH ERROR DETECTED.
CURFLD:	0			;THE CURRENT DATA FIELD
FRSTFD:	0			;FIELD # BEFORE FIND
SAVFLD:	BLOCK	5		;A TEMP SAVE AREA FOR TFRRD
FULLEN:	0			;FULL LENGTH OF CURRENT FIELD
ERRLIN:	0			;THE ERROR LINE FOR THIS FORM
FLDPTR:	0			;FIELD PASSED TO FIND.
FRMFIL:	BLOCK	130/5+1		;STRING FOR FORM NAME
INTBUF:	BLOCK	255/5		;INTERNAL TYPE CONVERSION BUFFER
INTBF0:	0			;TO FORCE INTBUF TO BE ASCIZ
SUBX:	-1			;INDEX TO SUBTAB
SUBY:	0			; "     "  "
SUBP:	0
TOTNRD:	0			;TOTAL # RD IN A SUB-FIELD TYPE FIELD
NUMREM:	0			;NUMBER REMAINING (FILL)
YET2WT:	0			;TOTAL YET 2 WRITE IN (WRITE)
LINFLD:	0			;CURRENT LINE
COLFLD:	0			;CURRENT COLM
LENFLD:	0			;CURRENT LENGTH
VALFLD:	0			;CURRENT VALUE PTR
OFFFLD:	0			;CURRENT OFFSET IN W.S.
NEWDAT:	0			;NEW DATA INDICATOR

REMARK	TEXTI TABLES FOLLOW FOR USE IN FLDRD ROUTINE.

TXTTAB:
	7			;NUMBER OF WORDS FOLLOWING
	RD%JFN+RD%RAI+RD%SUI+RD%BBG+RD%CRF ;FLAGS
	.PRIIN,,.PRIOU		;I/O JFN'S
	0			;POINTER TO INPUT DESTINATION
	0			;NUMBER OF BYTES AVAIL IN DESTINATION
	0			;BUFFER START; SAME VALUE AS IN DEST.
	0			;CTRL-R BUFFER POINTER
				;THIS IS THE CTRL-R BUFFER AND IS
				;LOCATED IN THE TERMINAL DEPENDENT
				;ROUTINES.
				;FOR A VT52 & VT05 IT IS THE WORD
				;OF COMMANDS NEEDED TO POSITION THE
				;CURSOR TO THE CORRECT PLACE.
;**; [112] REMOVE TXTAN	CLRH	28-JUL-80
;[112]	TXTAN			;POINTER TO BREAK CHARACTER SET

; DATA AREA FOR ARGUMENTS TO FUNCT. CALLS TO LIBOL

IMP%ER:	BLOCK 1			;ERROR CODE FOR FUNCT.
IMP%ST:	BLOCK 1			;STATUS CODE FOR FUNCT.
IMP%PT:	BLOCK 1			;ADDRESS OF MEMORY
IMP%SZ:	BLOCK 1			;SIZE OF MEMORY



PURGE HISTEP

	END