/QUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
/
/++

/	FACILITY:
/	ABSTRACT:
/	ENVIRONMENT:

/	AUTHOR:ALICIA FODEN/MIKE STURAK		CREATION DATE: OCTOBER 27,1980
/
/
/	033	EMcD	27-Sep-85	Add Dutch/Spanish Xlations
/	032	EMcD	15-Sep-85	Add Nordic translations
/	031	RCME	10-APR-85	Add handling of multinational and
/					technical characters in field names
/
/	-------------------- All below refer to V2.0 and earlier ----------------
/
/	030	TCW	02-NOV-83	ADD CHECK & TEXT FOR WINCHESTER DRIVE
/	029	HLP	29-AUG-83	If type incorrectly to GO prompt
/					  do not repaint screen, show error
/	028	WCE	17-AUG-83	Removed code that generates CDF/CIF's
/	027	WCE	19-JUL-83	Modified labels for new prefix file
/	026	WCE	06-JUL-83	Removed WS102 conditionals and code
/
/	025	MJS	01-JAN-83	Corrected some error messages that may
/					have been "misleading" to the user
/					(the corrections consistes of "NOP"ing
/					or "JMP"ing around code)
/
/	024	AIB	10-DEC-82	Conditionalized "Rubout key" messages

/	023	MJS	12-NOV-82	Cosmetic wording changes to message
/					at "TRYAGN"....same wording if you were
/					typing to Main Menu and got an error
/
/	0022	AIB	28-SEP-82	MORE COSMETIC WORDING CHANGES
/	0021	AIB	30-AUG-82	WORDING CHANGES IN SOME MENUS

/	0020	MJS	1-APR-82	Bug fix added 'GET DENSITY' in 'GTDKID'

/	0019	MJS	25-MAR-82	'Bug fix #dm-481' changed 'jmp cusgr'
/					to 'jmp cusr1' at 'dtao' permitting
/					GOLD Menu to return to MAIN Menu and
/					not sort menu asking for new 't a o'.

/	0018	MJS	09-MAR-82	Cosmetic display fix in 'nomean'

/	0017	MJS	16-FEB-82	CHANGED 'SREXT=10' to 'SREXT=20'
/					(double density and goto page increased
/					number of header blocks permitted)
/					ALSO-deleted 'wpssdf.pa' from the
/					wpstpr line within master.inf
/					(was never needed)
/	0016	GDH	08-FEB-82	Implemented "read error detection".
/	0015	MJS	19-NOV-81	Moved the 'xxsdfnbuffer' from field 5
/					to field 4
/	0014	AJF	06-OCT-81	CHANGED DDCHK TO ONLY LOOK AT BLOCK
/					NUMBER OF ALLOC BLOCK
/	0013	GR	30-SEP-81	Fixed Press Return problem
/	0012	JM	03-SEP-81	FRENCH TEXT CHANGES
/	0011	JM	03-SEP-81	FIXED TYPING "-" HAS NO MEANING MESSAGE
/	0010	GDH	26-Aug-81	WPFILS calling seq changes.
/	0009	TT	09-JULY-81	REMOVED SUPERFLUOUS CONDITIONALS
/	0008	AJF	25-JUNE-81	MISCELLANEOUS COSMETIC FIXES
/	0007	AJF	31-MAR-81	VERSION 1 CLEANUP AND MULIT KEY STUFF
/	0006	JM	10-MAR-81	Entered CANADIAN text
/	0005	JM	09-MAR-81	Entered DUTCH text
/	0004	JM	05-MAR-81	Entered FRENCH text
/	0003	AJF	18-MAR-81	CHANGED RD1CHAR CALL IN GETFNCHAR TO
/					PROCESS BLANKS
/
/	0002	AJF	20-FEB-81	DELETE 127 BLOCK SIZE RESTRICTION IN
/					TSTSZ
/	0001	AJF	27-OCT-81	ADDED SORT/PARSER MODULE TO SYSTEM
/--
/

/ WRITE OUT SORT PARSER

/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****


	FIELD 0
	*200
	JMP I	.+3
	JMP I	.+1
	7600
	RXLOAD
	*RXLDLS
	RXEWT=4
	RXEWT
	0
	RXQBLK=11
	RXQBLK
	.
	DLOSPR;100;CDF 30;-DSOSPR
	0
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****
/ *****     *****     *****     *****     *****       *****

/ WPSPAR.PA - SORT PARSER

/D028	/ THE 'USER FIELD' CONSTANTS
/D028	/
/D028		USRFL0=	-10	/ USER FIELD 0
/D028		USRFL1=	0	/ USER FIELD 1
/D028		USRFL3=	20	/ USER FIELD 3 (PHYSICAL FIELD 5)
/D028	/
/D028	/ REPLACES THE 'JMS' WITHIN THE MAINLINE CODE WITH THE ACTUAL (CDF) (CIF) IOT

	FIELD 3

	*SOTFL		/ THE FIRST 100 LOCATIONS CONTAIN COMMON SYSTEM CONSTANTS
			/ (E.G. P177, ETCETERA.)
/	*SDFNBUFFER	/THIS WILL BE DEFINED IN SORT IN SORT FIELD	/D007

	*FTYPE+1

	CDFSDFN=6241							/A014

/D028		CDFSRT=JMS .; .; JMS CIDPAT; CDF+USRFL3
/D028		CDFEDT=JMS .; .; JMS CIDPAT; CDF+USRFL1
/D028		CDIMNU=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL0
/D028		CDFMNU=JMS .; .; JMS CIDPAT; CDF+USRFL0
/D028		CIFMNU=JMS .; .; JMS CIDPAT; CIF+USRFL0
/D028		CDISRT=JMS .; .; JMS CIDPAT; CDF!CIF+USRFL3

	CDFMYF=CDFEDT	/DEFINE INSTRUCTION TO RETURN TO THIS FIELD	/M028
	CDFSRT=CDFLP	/DEFINE INSTRUCTION TO CHANGE TO SORT FIELD	/A028
	CDISRT=CDILP	/DEFINE INSTRUCTION TO CHANGE TO SORT FIELD	/A028

/D028	/THE ALL PURPOSE ROUTINE FOR THE INSTRUCTIONS
/D028	/
/D028	CIDPAT,	.
/D028		DCA	SAVEAC	/SAVE THE AC AT ENTRY
/D028		RAL; DCA SAVEL	/AND THE LINK
/D028		RIF		/FIND THE INSTRUCTION FIELD
/D028		TAD	CDF0	/SAME AS 'TAD (CDF 0)'
/D028		DCA	CID	/STORE THE MODIFIED INSTRUCTION FOR EXECUTION
/D028	CID,	.		/ CODE TO SET THE 'DATA FIELD' SAME AS 'INSTRUCTION FIELD'
/D028		AC7776		/ -2 FROM THE RETURN ADDRESS
/D028		TAD	CIDPAT	/GET YOU THE ADDRESS OF THE CALLER
/D028		DCA	CID	/SO AFTER ALL THAT SAVE IT
/D028		AC7777		/ -1
/D028		TAD I	CID	/GET THE ADDRESS OF THE CALLER
/D028		DCA	CID	/STORE IT SO A EXIT CAN BE MADE FROM THE INTERNAL ROUTINE
/D028		RIF
/D028		TAD I	CIDPAT	/GET AND STORE THE GENERATED INSTRUCTION
/D028		DCA I	CID
/D028		TAD SAVEL; CLL RAR /RESTORE LINK
/D028		TAD	SAVEAC	/GET THE OLD CONTENTS OF THE AC
/D028		JMP I	CID	/JUMP TO THE INSTRUCTION NOW CREATED
/D028	SAVEAC,	0		/HOLDS THE AC AT ENTRY TO CIDPAT
/D028	SAVEL,	0		/HOLDS THE LINK AT ENTRY TO CIDPAT
/
/
/
/
/
PZERR,	ERR1		/STANDARD SPEC DOC  ERROR MESSAGE
PZNRM,	ERR2		/MESSAGE OF SUCCESSFUL PARSING OF AT LEASE
			/ONE LINE OF SPEC DOC GIVING USER CHOICE OF
			/CONTINUING OR GOLD M ING OUT.
OUTTMP, ZBLOCK	2	/Single character output store.			/a031
NEGSPC, -40		/Negative ASCII value for space.		/a031
CHR2VT,	ZBLOCK	1	/Terminal output store				/a031

PAGE

BELL=	7		/ <BELL>
BACKSP=	10		/ <BACKSPACE>
LF=	12		/ <LINE FEED>
CR=	15		/ <CARRIAGE RETURN>
/d0017	KVTWIDTH=121	/ 81(10) IS THE WIDTH OF A LINE OF THE VT
A12=X2			/ auto index-register 12
A13=X3			/ auto index-register 13
SREXT=20		/ADDED TO SIZE OF LIST DOC DURINGSIZING		/m0017
MUISTR=MUBUF+MNIBUF

ERR001=	JMP I PZERR	/ 'GENERAL ERROR' CALL:		ERR001
ERR002=	JMP I PZNRM	/ 'ENOUGH FIELDS SPECIFIED' ERROR CALL:	ERR002
ADRASM= 0		/THIS ASSEMBLES THE CREATE MODULE SO IT WILL NOT
			/TRY TO DISPLAY ERROR MESSAGES BUT SET THE AC FOR
			/A PARTICULAR MESSAGE SO WPSTPR DISPLAYS APPROPRIATE
			/MESSAGE ON CREATE ERROR

/SORT START COMMAND		
CUSRCM,			
	XX		
	CLA		
	/ZERO FILE NUMBERS FOR ERROR RECOVERY
	DCA SOTFL	
	DCA SLSTFL	
	DCA CUSRFO	
	DCA ORDER		
	DCA STATUS
	DCA DSKID					/A007
	CDFMNU		
	TAD I (FNAMSP	/THIS IS THE ADDRESS OF A BUFFER TO HOLD
			/THE DOCUMENT ADDRESS

	CDFMYF		
	DCA CULFNM	/STORE IT IN CULFMN

/GET DISKETTE ID NUMBER
	/NOTE AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY
	JMS GTDKID	/GO GET DISKETTE ID
	CIA		/NEGATE
	DCA DSKNO	/STORE IT IN DKSNO
	TAD DSKNO	/GET IT BACK
	AND (777)	/MASK OFF FIRST THREE BITS
	DCA DSKID	/STORE FOR SORT				M007
CUGSP,			/PROMPT FOR SPEC DOC	
	CLA		/0 = ERASE FROM TOP OF SCREEN
	JMS ERASE
	JMS DCPRMT	/GO DISPLAY PROMPT
		GSPEC	/ADDRESS OF SPEC PROMPT
		CNRG	/NULL ARGUMENT TO DISPLAY BLANK ON NEXT LINE A008
	CDFMYF
	DCA STATUS	/STORE AC IN STATUS -1 = NONEXISTENT DOCUMENT
	CDFMNU
	TAD I (MUBUF+MNFNO)	 /GET SPEC DRIVE & DOC NUMBER
	CDFMYF			
	DCA CUSRFO		/SAVE SPEC DOC AND DRIVE NUMBER
	TAD CULFNM		/PATCH COPY COMMAND TO PICK UP STUFF
	DCA CUGSP1
	JMS CUCOPY		/COPY NAME TO OUR FIELD

CUGSP1,	0			/ADDRESS OF FROM FOR CUCUPY
	CDFMNU			/CDF FROM FIELD	
	CUSSDN			/ADDRESS TO RECEIVE SPEC DOC NAME
	CDFMYF			/CDF TO FIELD
	STRLEN			/NUMBER OF WORDS TO COPY  (THIS IS STANDARD)

	TAD CUSRFO	/GET SPEC FILE AND DRIVE NUMBER
	AND P377	/MASK OFF DOCUMENT NUMBER
	DCA CUSRC3	/SAVE DOCUMENT NUMBER FOR USER VERIFICATION MSG
	TAD CUSRFO	/GET SPEC DOC FILE AND DRIVE NUMBER
	BSW;RTR		/POSITION DRIVE NUMBER
	AND (17)	/MASK OFF DRIVE NUMBER
	DCA CUSRC4	/SAVE DRIVE NUMBER
	TAD STATUS
	SMA CLA		/-1 MEANS DOC DOESN'T EXIST NOTICE WE CLEAR AC HERE
	JMP GPARSE	/IF NOT MINUS CONTINUE
	JMS NDERR
		CUSSDN	/SPEC NAME
	CLA
	DCA STATUS	/SET STATUS BACK TO 0
		JMP CUGSP	/ASK FOR SPEC DOC AGAIN
/ALL THIS LOCK CODE IS HERE TO ENSURE USER DOESN'T SPECIFY RESULT DOC	A007
/AS ANY OTHER DOC. BECAUSE OF SPACE LIMITATIONS I WILL DO AN EQUALITY   A007
/TEST TO ENSURE LIST OR SPEC IS NOT OVERWRITTEN BY RESULT. THE  278 IS  A007
/A SINGLE USER SYSTEM, THEREFORE THERE IS NO NEED FOR ALL THESE LOCKS.  A007

/HERE WE GO TEST SPEC DOC FOR SYNTAX ERRORS

GPARSE,	TAD CUSRFO	/PUT SPEC DRIVE AND DOC NUMBER INTO AC FOR PARSER
	JMS PARSE	/GO CHECK SPEC DOC IF IS OK WE WILL CONTINUE IF NOT
			/RETURN TO MAIN MENU WITH ERROR MESSAGE
/THIS ROUTINE IS A WAIT SO USER WILL SEE THE SPEC AS THE PARSER DISPLAYS IT
	AC7776		/SET AC TO -2 SO LOOP WILL ITERATE TWICE
	DCA WTCTR1	/SET WAIT COUNTER TO 0
	DCA WTCTR	/SET OUTER LOOP COUNTER TO 0
LOOP,	CIFSYS		/MAKE INSTRUCTION FIELD SYSTEM FIELD
	JSWAP		/
	ISZ WTCTR	/WHEN AC IS BACK TO 0 INCREMENT OUTER LOOP
	JMP LOOP		/OTHERWISE LOOP
	ISZ WTCTR1	/INCREMENT OUTER LOOP IF ZERO CONTINUE
	JMP LOOP	/OTHERWISE LOOP AGAIN

CUSGL,			/PROMPT FOR NAME OF LIST DOC
	CLA		
	TAD CULFNM	
	DCA CUSGL1	/PATCH COPY COMMAND TO PICK UP STUFF
	JMS ERASE	/WILL ERASE ENTIRE SCREEN BECAUSE AC 0	

IFDEF FRENCH <								/A011
	AC0001		/SET GLSTFG TO INDICATE				/A011
	DCA	GLSTFG	/ THAT GLST TO BE DISPLAYED			/A011
>			/ END IFDEF FRENCH				/A011

	JMS DCPRMT	/CALL DISPLAY ROUTINE
		GLST	/ADDRESS OF LIST DOC PROMPT
		CNRG	/DISPLAYS BLANK ON NEXT LINE		A008
	CDFMYF
	DCA STATUS
	CDFMNU
	TAD I (MUBUF+MNFNO)	/GET DRIVE AND DOC NUMBER
	CDFMYF			/
	DCA SLSTFL		/SAVE

	JMP PCUSG

RETMNU,	CDIMNU			/RETURN TO MAIN MENU			/M027
	JMP I CUSRCM

PCUSG,	JMS CUCOPY
CUSGL1,
	0		/ADDRESS OF FROM FOR CUCOPY
	CDFMNU		/CHANGE TO MENU DATA FIELD TO PICK UP CHAR STRING
	CUSLDN		/ADDRESS TO RECEIVE LIST DOC NAME
	CDFMYF		/CHANGE BACK TO MY DATA FIELD (FIELD TO COPY TO)
	STRLEN		/NUMBER OF WORDS TO COPY (THIS IS STANDARD)

	TAD SLSTFL	/GET LIST DOC FILE AND DRIVE NUMBER
	AND P377	/MASK OFF DOCUMENT NUMBER	
	DCA CUSRC1	/SAVE DOCUMENT	
	TAD SLSTFL	/GET LIST DOC FILE AND DRIVE NUMBER
	BSW;RTR		/POSITION DRIVE NUMBER
	AND (17)	/MASK OFF DRIVE NUMBER	
	DCA CUSRC2	/STORE AWAY
	TAD STATUS
	SMA CLA		/CLEAR AC
	JMP CUSGR	/IF POSITIVE DOC EXITST SO CONTINUE		A007
	JMS NDERR	/ELSE GO TO NO DOCUMENT ERROR MSG
	
	CUSLDN		/LIST DOC NAME
	CLA
	DCA STATUS	/SET STATUS BACK TO 0
	JMP CUSGL	/DISPLAY PROMPT AGAIN



STATUS,	0	/TELL NO DOC ERROR ROUTINE WHERE TO RETURN
DSKNO,	0	/DISKETTE ID NUMBER
WTCTR,	0		/THIS IS THE WAIT ROUTINE COUNTER
WTCTR1,	0		/THIS IS WAIT ROUTINE COUNTER FOR OUTER LOOP
CULFNM,	0		/ADDRESS OF BUFFER TO HOLD DOCUMENT ADDRESS
CUSRFO,	0

IFDEF FRENCH <								/A011
GLSTFG,	0		/ SET WHEN GLST TO BE DISPLAYED			/A011
>			/ END IFDEF FRENCH				/A011

	PAGE


CUSGR,	CLA			/0 AC MEANS ERASE FROM TOP OF SCREEN
	JMS ERASE
SRCUSRG,JMS DCPRMT		/GO DISPLAY MESSAGE	
		GRES		/ADDRESS OF RESULT DOC PROMPT
		GRES2		/DISPLAYS SECOND LINE OF PROMPT

	CDFMYF			/CHANGE DATA FIELD TO MINE
	DCA STATUS		/STORE STATUS OF DOC (EXISTS OR NOT)
	CDFMNU			/CHANGE DATA FIELD TO MENU
	TAD I (MUBUF+MNDRV)	/GET RESULT DOC DRIVE
	CDFMYF			/CHANGE DATA FIELD TO MINE
	DCA CUSRC6		/STORE
	JMS DDCHK		/CHECK IF RESULT FLOPPY IS VALID DISKETTE
		JMP CUSGR	/ERROR RETURN INVALID DISKETTE IS REPLACED
				/SO ASK FOR RESULT AGAIN
	TAD STATUS		/DISKETTE IS VALID SO GO GET STATUS
	SPA CLA			/SEE IF DOCUMENT EXISTS IF AC NEGATIVE
	JMP RESCRE		/DOC DOESN'T EXIST SO GO CREATE IT
	CDFMNU			/CHANGE DATA FIELD TO MENU FIELD
	TAD I (MUBUF+MNFNO);CDFMYF	/ELSE GET DOC NUMBER
	DCA SOTFL		/AND STORE IT
	JMS CUSGR1

/SEE IF RESULT DOC HAS BEEN PREVIOUSLY SPECIFIED			A007
/NOTE AC IS 0 HERE

	TAD SOTFL		/GET RESULT DOC NUMBER			A007
	CIA			/NEGATE					A007
	TAD SLSTFL		/GET NEGATIVE OF LIST DOC		A007
	SNA CLA			/ARE THEY EQUAL?			A007
	JMS LCKMSG		/IF YES DISPLAY ERROR MESSAGE		A007
		JMP TSTSPEC	/CONTINUE ALSO OK RETURN FROM LCKMSG    A007
		JMP CUSGR	/ERROR RETURN PROMPT FOR RESULT AGAIN	A007
TSTSPEC,TAD SOTFL		/GET RESULT DOC				A007
	CIA			/NEGTATE				A007
	TAD CUSRFO		/ADD SPEC DOC				A007
	SNA CLA			/ARE THEY EQUAL				A007
	JMS LCKMSG		/YES DISPLAY ERROR MESSAGE		A007
		JMP DTAO	/NO CONTINUE THIS IS ALSO OK RETURN	A007
				/FROM LCKMSG				A007
		JMP CUSGR	/ERROR RETURN PROMPT FOR RESULT AGAIN   A007

/DOCUMENT EXISTS AND IS NOT IN USE SO DISPLAY TAO PROMPT
DTAO,	JMS ERASE		/ERASE SCREEN				A008
	JMS DSORT		/DISPLAY SORT
	CIFMNU
	JMS I IOACAL
		0
		DEXTS		/ADDRESS OF TEXT STRING
		205		/POSITION FIRST LINE ON SECOND ROW 5 COLUMN
		305
		505
		705
		1105
		2305
	JMS ORGOLD
		ORAR
DTAOX,				/					/a025
	AC0001			/SET AC TO 1 SO MENU WILL READ RESPONSE
	JMS READMU		/READ INPUT FROM MENU MODULE
		JMP CUSR1	/GOLD M -- Return to MAIN Menu		/a0019
/d0019		JMP CUSGR	/GOLD M SO ASK FOR RESULT DOC AGAIN
		CDFMYF		/CHANGE DATA FIELD TO MINE
		SMA CLA		/IF AC NEGATIVE INAPPROPRIATE INPUT
		JMP STORE	/IF APPROPRIATE CONTINUE
		JMS MVINPT	/ELSE, COPY INPUT FROM MENU FIELD TO INBUF
		JMS NOMEAN	/GO COMPLAIN ABOUT BAD INPUT
/d025		JMP DTAO	/ASK AGAIN				/d025
	JMP	DTAOX		/ ask again				/a025



/CALLED TO COPY RESULT DOC NAME FROM MENU FIELD AND ISOLATE DOC AND DRIVE
/NUMBERS MADE INTO A SUBROUTINE SO IT CAN BE USED WHEN DOC EXISTS OR NOT


CUSGR1,	XX			
	TAD CULFNM		
	DCA CUSGR2		
	JMS CUCOPY		

CUSGR2,	0			/FROM FOR CUCOPY
	CDFMNU			/
	CUSRDN			/RESULT DOCUMENT NAME
	CDFMYF			/
	STRLEN			/SIZE OF DOCUMENT NAME FOR CUCOPY

			/NOTE CUCOPY RETURNS WITH AC 0
	TAD SOTFL	/GET RESULT DOC FILE AND DRIVE NUMBER
	AND P377	/MASK OFF DOCUMENT NUMBER
	DCA CUSRC5	/SAVE DOC NUMBER
	TAD SOTFL	/GET RESULT DOC FILE AND DRIVE NUMBER
	BSW;RTR		/POSITION DRIVE NUMBER
	AND (17)	/MASK OFF DRIVE NUMBER
	DCA CUSRC6	/SAVE DRIVE NUMBER
	DCA STATUS	/CLEAR STATUS VARIABLE
	JMP I CUSGR1	/RETURN

/THIS ROUTINE IS CALLED BY ROUTINES WHICH PROCESS SPEC, INPUT DOCUMENT AND
/RESULT DOCUMENT NAMES.
/CALLED BY
/	JMS DCPRMT
/		ADDRESS OF PROMPT TO DISPLAY
/		ADDRESS OF SECOND LINE OF PROMPT, IS NULL (BLANK) FOR SPEC
/			AND LIST DOC, TEXT FOR RESULT DOC
/		RETURN WITH AC CONTAINING VALUE OF MNTMP3
/		DATA FIELD SET TO MENU FIELD

DCPRMT, XX
	CLA		/CLEAR AC
	TAD I DCPRMT	/GET FIRST PARAMETER PROMPT TO DISPLAY
	DCA WHCDOC	/STORE IT
	ISZ DCPRMT	/GET READY TO GET NEXT PARAMETER
	TAD I DCPRMT	/GET SECOND LINE OF PROMPT, IS NULL (BLANK) FOR
			/SPEC AND LIST PROMPT BUT FOR RESULT CONTAINS
			/SECOND LINE OF PROMPT
	DCA WHC2ND	/STORE
	ISZ DCPRMT	/INCREMENT DCPRMT FOR RETURN
DCPRM1,	JMS DSORT
	CIFMNU
	JMS I IOACAL
		0
		SPRMPT
		1505
	LOC,	7777	/WILL DISPLAY PROMPT ON SAME LINE AS ABOVE PROMPT
	WHCDOC, 0000
	CIFMNU
	JMS I IOACAL
		0
	WHC2ND,	0000	/SECOND LINE OF PROMPT
		1605	/POSITION OF SECOND LINE



	JMS PRETURN
	JMS ORGOLD
		ORAR
	CLA		/SET AC TO MENU WILL READ INPUT
	JMS READMU	/PROCESS INPUT FROM MENU
	JMP CUSR1	/RETURN TO MM
	JMP I DCPRMT	/GO BACK AND PROCESS INPUT NOTE DATA FIELD
			/STILL SET TO MENU FIELD

	
	PAGE

RESCRE, CDFMNU			/CHANGE DATE FIELD DO MENU
	TAD I (MUBUF+MNDRV)	/NOTE AC 0 HERE, GET DRIVE NUMBER OF DOC
				/USER SPECIFIED
	CDFMYF			/CHANGE DATA FIELD BACK TO MINE
	DCA CUSRC6		/STORE IN RESULT DRIVE NUMBER
	JMS TSTSZ		/TEST IF THERE IS ROOM TO CREATE DOC
		JMP SMDRVS	/ERROR RETURN GO PROCESS SIZE ERROR
	CLA CLL
	TAD DSKID		/GET DSKID			M007
	AND (4777)		/CLEAR BITS 1 AND 2 IN CASE THEY ARE
	DCA DSKID		/SET FROM PREVIOUS RESULT DOC	M007
	CLL			/THERE  IS ENOUGH ROOM SO CONTINUE CLEAR LINK
	AC0003			/SET FOR OVERWRITE
	RTR
	RTR			/MOVE TO BITS 2 AND 2
	CDFMYF
	TAD DSKID		/COMBINE WITH CONTENTS OF DSKID		M007
	DCA DSKID		/STORE 					M007
	JMS ADRCRT		/CREATE THE OUTPUT DOCUMENT
	JMP CRERR		/ERROR ON CREATE, PROCESS
	DCA SOTFL		/STORE IN DOC NUMBER IN SOTFIL
	JMS CUSGR1		/GO COPY DOC NAME AND ISOLATE DOC AND DRIVE #S
				/NOTE AC MUST BE 0 HERE TO ENSURE RESULT DOC
				/IN SIZE TESTING ROUTINE EQUALS ZERO
				/BECAUSE WE ARE NOT OVERWRITING THE RESULT
	JMP CUSGO		/CONTINUE




CRERR,	CLA		/CLEAR AC
	TAD ERSTAT	/GET ERROR STATUS FROM CREATE
	SNA		/IF AC 0
	JMP STMSG	/DISPLAY SHORT MESSAGE
	TAD (7776)	/ELSE ADD -2	TO SEE IF AC = 2
	SZA CLA		/AC =2?
	JMP WRGMSG	/DISPLAY WRONG DOC NUMBER MESSAGE
	JMP NSPCMSG	/ELSE MUST BE A 2 DISPLAY NO SPACE FOR DOC MESSAGE
STMSG,	TAD (CNRG)	/GET NO DISPLAY ARGUMENT
	JMP CREMSG	/GO TO DISPLAY CREATE ERROR MESSAGE
WRGMSG,	TAD (WNUM)	/GET WRONG DOCUMENT NUMBER ARGUMENT
	JMP CREMSG	/GO TO DISPLAY CREATE ERROR MESSAGE
NSPCMSG,TAD (NMDC)	/GET NO DOCUMENTS AVAILABLE ARGUMENT
	JMP CREMSG	/GO TO DISPLAY CREATE ERROR MESSAGE

CREMSG,	DCA CRMSG	/STORE APPROPRIATE MESSAGE ARGUMENT FOR DISPLAY
CRMSG1,	JMS ERASE
	JMS RBELL
	JMS DSORT	/DISPLAY SORT ON FIRST LINE			/A008
	CIFMNU
	JMS I IOACAL
		0
		CNTCRE	/DISPLAY CANNOT CREATE DOCUMENT
		1505	/ON LINE 15 COLUMN 5
	CIFMNU		
	JMS I IOACAL
		0
	CRMSG,	0000	/DISPLAY DOC # OUT OF RANGE, OR NO MORE DOCS
		1605
	CIFMNU		/CHANGE INSTRUCTION FIELD TO MENU
	JMS I IOACAL	/CALL IOA					A008
		0	/						A008
		TARTN	/DISPLAY PRESS RETURN TO TRY ANOTHER NAME	A008
		2005	/LINE TO DISPLAY 				A008
	JMS ORGOLD	/DISPLAY PRESS GOLD M				A008
		ORAR	/DISPLAY OR					M008
	JMS KBRD		/READ INPUT HANDLE GOLD KEYS		D008
	JMP CUSGR		/RETURN WAS TYPED SO REQUEST RESULT AGAIN A008

STORE,	CLA CLL			/CLEAR LINK AND AC
	TAD DSKID		/GET DSKID				M007
	AND (4777)		/CLEAR BITS 1 AND 2 IN CASE THEY WERE SET
				/PREVIOUSLY WHEN RESULT WAS SPECIFIED
	DCA DSKID		/STORE BACK				M007
	CDFMNU			/CHANGE DATA FIELD TO MENU FIELD
	CLA CLL
	TAD I (MUBUF+MNTMP1)	/GET INPUT
	CDFMYF			/CHANGE BACK TO MY DATA FIELD
	RTR			/
	RTR			/MOVE INPUT TO BITS 1 AND 2
	TAD DSKID		/STORE IN DSKID				M007
	DCA DSKID		/					M007
	CDFMNU		/CHANGE DATA FIELD TO MENU FIELD
	TAD I (MUBUF+MNTMP1) /GET INPUT AGAIN
	CDFMYF		/CHANGE DATA FIELD TO MINE
	CLL RAR		/SEE IF WE ARE OVERWRITING
			/0 = ADD TO TOP
			/1 = ADD TO BOTTOM
			/3 = OVERWRITE  (NOTE THESE ARE BINARY NUMBERS)
			/IF OVERWRITING AC NOT 0
	SNA CLA		/CONTINUE IF AC IS NOT EQUAL TO 0
	JMP CLTSTSZ	/GO TO TEST SIZE
			/ELSE
	TAD SOTFL	/GET SIZE OF RESULT FILE
	CIFFIO		/SET INSTRUCTION FIELD TO MENU			/M0010
	FILEIO		/						/M0010
	XRDFIN
	CDFFIO		/CHANGE DATA FIELD TO FILEIO			/M0010
	TAD I (RDFSIZ)	/GET SIZE OF RESULT FILE
	CDFMYF		/CHANGE DATA FIELD BACK TO MINE
CLTSTSZ,JMS TSTSZ	/GO TO TSTSZ WITH SIZE OF RESULT DOC IN AC
	JMP SMDRVS	/ERROR RETURN CONTINUE SIZE ERROR HANDLING

		JMP CUSGO	/OK RETURN CONTINUE

/RTNWT MOVED HERE BECAUSE OF SPACE REASONS			M007

/ THIS ROUTINE READS INPUT IN RESPONSE TO ERROR MESSAGES WHICH REQUEST A RETURN
/ WHEN "RETURN" IS TYPED RETURN TO USER IF NOT RING BELL AND COMPLAIN AGAIN

/ called by: JMS RTNWT; WRONG RETURN; OK RETURN

RTNWT,	XX
	CIFMNU			/
	  JMS I	INACAL		/
		INBUF		/ INPUT BUFFER TO RECEIVE INPUT
	  JMP	.-3		/					/a025
/d025	  JMP	WRNG		/ GOLD KEY RING BELL COMPLAIN AGAIN	/a025
	CLA MQA			/ MQ HAS # OF CHARS IF NOT 0 THEN NOT RETURN
	SZA CLA			/ SEE IF IT IS 0
	JMP	WRNG		/ IF NOT RETURN RING BELL COMPLAIN AGAIN
	ISZ	RTNWT		/ MUST BE RETURN SO INCREMENT FOR OK RETURN
	JMP I	RTNWT		/ RETURN TO CALLER
WRNG,	JMS	RBELL		/ RING BELL

	JMP I	RTNWT		/ RETURN TO CALLER TO COMPLAIN AGAIN

	PAGE


/IF CALLED WITH ZER0 IN AC THIS ROUTINE CHECKS SIZE OF SPACE ON RESULT
/FLOPPY AGAINS SIZE OF INPUT FLOPPY + 8 BLOCKS

/OTHERWISE AC CONTAINS SIZE OF RESULT DOC TO ADD TO FREESPACE ON RESULT
/FLOPPY WHEN OVERWRITING THE RESULT DOC
/IF THERE IS ENOUGH SPACE ON RESULT FLOPPY TO ACCOMMODATE OUTPUT PROGRAM
/CONTINUES.
/WHEN THERE IS NOT ENOUGH SPACE ON RESULT FLOPPY DISPLAYS ARE DETERMINED
/AS FOLLOWS:
/IF INPUT AND OUTPUT ARE THE SAME, USER IS ASKED TO SPECIFY ANOTHER DRIVE
/FOR OUTPUT AND IS RETURNED TO THE PROMPT FOR THE RESULT DOCUMENT SO
/APPROPRIATE VALIDLITY TESTS ARE PERFORMED.

/IF INPUT IS DRIVE 0 AND OUTPUT IS DRIVE 1 USER IS ASKED TO REPLACE
/DISKETTE AND RESPECIFY RESULT DOCUMENT AS ABOVE.
/IF OUTPUT AND ARE DIFFERENT AND OUTPUT IS DRIVE 0 USER IS ASKED TO
/REMOVE SYSTEM FLOPPY

TSTSZ,	XX
	DCA FRESPCE	/STORE RESULT DOC SIZE OR 0 DEPENDING HOW CALLED	
	TAD SLSTFL	/PUT INPUT DRIVE AND DOC NUMBER INTO AC
	CIFFIO		/CALL RFDL TO OPEN INTPUT DOC			/M0010
	FILEIO		/						/M0010
	XRDFIN
	CDFFIO		/						/M0010
	TAD I (RDFSIZ)	/GET SIZE OF LIST DOC
	CDFMYF		/CHANGE TO MY DATA FIELD
	DCA LSTSIZ	/STORE IN MY FIELD

	TAD CUSRC6	/TAD RESULT DRIVE NUMBER
	JMS CUPDRS	/SET DRIVE NUMBER FOR QURX
	TAD (RXESP	/GET SPACE LEFT ON DISKETTE
	DCA QUQBLK+RXQFNC
	JMS QURX
	CLA		/THIS ERASES ANY ERROR RETURN FROM QURX
	TAD QUQBLK+RXQSPC	/GET FREE SPACE ON RESULT FLOPPY
	TAD FRESPCE	/ADD RESULT DOC SIZE (OR 0 FOR T, A, OR CREATE)
	DCA FRESPCE	/STORE
	TAD (SREXT)	/THIS IS EXTRA SPACE REQUIRED IF DOC IS TO BE
			/EDITED AFTER SORT
	TAD LSTSIZ	/ADD THE SIZE OF INPUT DOC
	CIA		/NEGATE
	TAD FRESPCE	/ADD FREE SPACE
	SPA CLA		/IF RESULT IS NEGATIVE INPUT IS GREATER THAN
	JMP I TSTSZ	/SPACE AVAILABLE ON FLOPPY ERROR RETURN
	ISZ TSTSZ	/ELSE THERE IS ENOUGH SPACE INCREMENT FOR OK RETURN
	JMP I TSTSZ

ERSTAT,	0000	/TYPE OF CREATE ERROR MESSAGE TO DISPLAY
		/0 = GENERAL CANNOT CREATE
		/1 = DOC # OUT OF RANGE
		/2 = NO DOCS AVAILABLE

LSTSIZ,	0	/SIZE OF INPUT FILE
FRESPCE,0	/SIZE OF RESULT FILE 0 WHEN ADDING TO TOP, BOTTOM OR CREATING
		/THE RESULT DOC AND THE SIZE OF THE RESULT DOCUMENT WHEN
		/OVERWRITING. THIS PROGRAM ALSO ADDS THE AMOUNT OF FREE SPACE
		/ON THE RESULT FLOPPY WHEN COMPUTING SIZING

/ IF GLST (FRENCH) HAS JUST BEEN DISPLAYED, DSPACC IMBEDS AN ACCENTED a	/A011
/ (^Z 141) ONTO THE SCREEN WITHIN GLST. THIS COULD NOT BE DONE NORMALLY	/A011
/ BECAUSE GLST IS A ^S ARGUMENT ITSELF.					/A011

IFDEF FRENCH <								/A011
DSPACC,	XX								/A011
	CLA								/A011
	TAD	GLSTFG							/A011
	SNA CLA			/ HAS GLST BEEN DISPLAYED ?		/A011
	JMP I DSPACC		/ NO, SO RETURN				/A011
	DCA	GLSTFG		/ YES, CLEAR GLSTFG UNTIL NEXT DISPLAY	/A011
	CIFMNU			/ AND DISPLAY ACCENTED CHAR		/A011
	JMS I	IOACAL							/A011
		0							/A011
		ACCHAR							/A011
		1536		/ CURSOR POS				/A011
		141		/ ACCENTED a				/A011
	JMP I	DSPACC		/ RETURN				/A011

ACCHAR,	TEXT '^P^Z'		/ STRING USED TO DISPLAY ACCENTED a	/A011
>				/ END IFDEF FRENCH			/A011

/****************************************************************************
/
/ The OUT2VT routine, which displays characters on the terminal has	/a031
/ been moved here to make room for the changes associated with outputing/a031
/ multinational and technical characters.				/a031
/
/****************************************************************************

OUT2VT,	XX			/ The moved output to terminal routine	/m031
	DCA	CHR2VT		/ Save the character to be displayed	/m031
	TAD	CHR2VT		/ Check for <CR> right away		/m031
	TAD	(-CR)		/					/m031
	SNA CLA			/ Is it an end dead char (CR)?		/a031
	JMP	OU2LIV		/ Yes, tidy up after dead key sequence.	/a031
	TAD	DEADKEY		/ No, check for in dead key sequence.	/m031
	SZA CLA			/ Are we in dead key sequence?		/m031
	JMP	INDEAD		/ Yes, deal with the character.		/a031
	TAD	CHR2VT		/ No.					/m031
	TAD	(-BACKSP)	/ Check for a <BS>.			/m031
	SNA			/ Was it a start of dead character (BS)?/m031
	JMP	OU2DOA		/ Yes, start of dead key sequence.	/a031
	TAD	(BACKSP-LF)	/ No, test for line feed.		/m031
	SZA CLA			/ Is it an LF?				/m031
	JMP	NOTEOL		/ No, jump round handler.		/m031
	JMS	NEWLN		/ Output a CR-LF.			/m031
VTEXIT,	TAD	CHR2VT		/ Get back the character		/m031
	JMP I	OUT2VT		/ Return				/m031

NOTEOL,	TAD	CHR2VT		/ Output the character passed to the	/a031
OU2ANY,	JMS	OUTCHR		/ routine origionally in the AC		/a031
	JMP	VTEXIT		/ and return with it in AC		/a031

OU2DOA,	AC7777			/ Set the dead key flag			/a031
	DCA	DEADKEY		/					/a031
	JMP	VTEXIT		/ Get the character back and return	/a031

/****************************************************************************
/
/	The following code handles dead key sequences found in the	/a031
/	sort specification document.  Technical and multinational	/a031
/	characters are now displayed using the correct character sets	/a031
/	and user dead key sequences are depicted by the conventional	/a031
/	blot rather than the +/- symbol previously used.		/a031
/
/****************************************************************************

INDEAD,	ISZ	DEADKEY		/ This peice of code is used for each	/a031
				/ character in the dead key sequence	/a031
				/ Is this the first char in the sequence?/a031
	JMP	INDNOT1		/ No, deal with others.			/a031
	ISZ	DEADKEY		/ Yes, set the dead key flag again	/a031
	TAD	CHR2VT		/ No, get the character.		/a031
	TAD	NEGSPC		/ Test for space character.		/a031
	SNA CLA			/ Is it a space?			/a031
	JMP	VTEXIT		/ Yes, accept and forget it.		/a031
	CIFMNU			/ No, output the escape sequence to send/a031
	JMP I	IOACAL		/ a blot to the screen			/a031
	   0			/					/a031
	   ASTRING		/					/a031
	   ASDK			/					/a031
	AC4000			/ Set the top bit of the dead key flag	/a031
	DCA	DEADKEY		/ to indicate a user dead key that	/a031
	JMP	VTEXIT		/ requires no further processing	/a031

INDNOT1,TAD	DEADKEY		/ Check the top bit of the flag for user/a031
	SPA			/ Is this a user dead key sequence?	/a031
	JMP	VTEXIT		/ Yes, ignore all further characters	/a031
	CLL RTR			/ No, test for the 2nd char in sequence	/a031
	SZA			/ Is this the 2nd character?		/a031
	JMP	OU2DCH		/ No, it's a later one			/a031

	TAD	CHR2VT		/ Yes, get it.				/a031
	TAD	NEGSPC		/ Test for a GOLD space.		/a031
	SNA			/ Is it a GOLD space?			/a031
	JMP	GLDSPC		/ Yes, deal with it.			/a031

	TAD	(-23)		/ No, test character set specifier	/a031
	SNA			/ Is it a technical character?		/a031
	JMP	OU2DTC		/ Yes, go send an SS3			/a031

	IAC			/ Test for multinational character set	/a031
	SNA CLA			/ Is it multinational?			/a031
	JMP	OU2DMC		/ Yes, output an SS2			/a031
	JMP	OU2DLC		/ No, is line drawing, so output SO	/a031

OU2DTC,	AC0001			/ Build value 217 for technical char	/a031
OU2DMC,	TAD	(200)		/ Build value 216 for multinational char/a031
OU2DLC,	TAD	(16)		/ Build value 16 for a line drawing char/a031
	JMP	OU2ANY		/ Output the built value to the screen	/a031

OU2DCH,	CLL RAL			/ Check that this is the 3rd character	/a031
	SZA CLA			/ Is this the 3rd character?		/a031
	JMP	VTEXIT		/ No, exit				/a031
	JMP	NOTEOL		/ Yes, print it				/a031

GLDSPC,	AC4000			/ Deal with GOLD spaces. Is not dead key/a031
	DCA	DEADKEY		/ sequence, so set flag to ignore rest	/a031
	JMP	NOTEOL		/ Display the space			/a031

OU2LIV,	DCA	DEADKEY		/ Turn off the deadkey flag		/a031
	TAD	(17)		/ Output SI when dead key finishes	/a031
	JMP	OU2ANY		/ clean up after line drawing set mode  /a031

OUTCHR,	XX			/ Routine to display the character in AC/a031
	DCA	OUTTMP		/ Save the character			/a031
	CIFMNU			/ Change to the menu field		/a031
	JMS I	IOACAL		/ to use IOA for character output	/a031
	   0			/					/a031
	   ASTRING		/					/a031
	   OUTTMP		/					/a031
	JMP I	OUTCHR		/ Return				/a031

DEADKEY,ZBLOCK	1		/ Dead key flag				/m031

	PAGE

/SEE IF INPUT AND OUTPUT DOCS ARE IN SAME DRIVES

SMDRVS,	TAD CUSRC2	/GET INPUT DRIVE NUMBER
	CIA		/NEGATE
	TAD CUSRC6	/RESULT DRIVE NUMBER	
	SZA CLA		/IF THEY ARE EQUAL TELL USER TO SPECIFY ANOTHER DRIVE
	JMP DKTST	/OTHERWISE SEE IF 4 DRIVE SYSTEM		M007
NDPRMT,	JMS ERASE
	JMS TOSMALL	/TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT
	CIFMNU
	JMS I IOACAL
		0
		NWDRV		/TEXT TELLING USER TO SPECIFY ANOTHER DRIVE
		1205		/DISPLAY NEXT PROMPT ON LINE 12 COLUMN 5
	NWSTR, 0000		/ ADDR OF SUBSTRING			/A030
	JMP SRCUSRG	/GO PROMPT FOR RESULT DOC AGAIN

DKTST,	CDF 0		/CHANGE DATA FIELD TO SYSTEM FIELD		  A007
	TAD I (RXONLN)	/GET NUMBER OF DISKETTES ON LINE NOTE AC IS ZERO  A007
	CDFMYF		/CHANGE DATA FIELD BACK TO MINE			  A007
	TAD (-4)	/SEE IF IT IS 4					  A007
	SNA CLA		/IF THERE OR 4 RX'S ON LINE			  A007
	JMP NDPRMT	/DISPLAY SPECIFY ANOTHER DRIVE			  A007
			/OTHERWISE FALL THROUGH 			  A007
			/DRIVES ARE DIFFERENT AND THIS IS 2 DRIVE SYSTEM
			/SEE IF INPUT DRIVE IS 0
DFDRVS,	TAD CUSRC6	/GET OUTPUT DRIVE NUMBER
	SNA CLA		/IF IT IS NOT ZERO GO TO REPLACE DISKETTE ROUTINE
	JMP OUTPT0	/IF IT IS ZERO TELL USER TO REPLACE SYSTEM DISKETTE
	JMP DFMSG

DFMSG,	JMS PTRCHK	/MAKE SURE NOTHING IS PRINTING. IF PRINTING USER
			/IS RETURNED TO THE MAIN MENU OF NOT CONTINUE
	JMS ERASE
	JMS TOSMALL	/TELL USER THERE IS NOT ENOUGH ROOM FOR RESULT

	CIFMNU
	JMS I IOACAL
		0
		RPLACE		/ASK USER FOR NEW DISKETTE FOR RESULT DOC
		1205		/DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5
		1305		/DISPLAY SECOND LINE ON LINE 13 COLUMN 5
	JMP SRCUSRG	/DISKETTE OK NOW PROMPT FOR RESULT DOC AGAIN

OUTPT0, JMS PTRCHK	/MAKE SURE USER IS NOT PRINTING IF SO RETURN TO MM
			/ELSE CONTINUE
OT0MSG,	JMS ERASE
	JMS TOSMALL	/TELLS USER THERE IS NOT ENOUGH ROOM FOR RESULT
	CIFMNU
	JMS I IOACAL
		0
		RMOVE0		/ASK USER FOR NEW DISKETTE FOR RESULT DOC
		1205		/DISPLAY REPLACE PROMPT ON LINE 12 COLUMN 5
		1305		/DISPLAY SECOND LINE ON LINE 13 COLUMN 5
	JMP SRCUSRG	/GO BACK AND PROMPT FOR RESULT DOC AGAIN



CUSGO,	JMS ERASE	/ERASE SCREEN					A008
	JMS DSORT	/GO DISPLAY SORT
	CIFMNU		/CHANGE TO MENU FIELD
	JMS I IOACAL	/OUTPUT WHAT WE THINK THINGS ARE
		0
		CUSR1A	/ADDRESS OF OUTPUT STRING
		105	/TEXT TO DISPLAY ON 1 LINE 5 COLUMN 5
	IFDEF CANADA <141>
	CUSRC2,	0	/DRIVE NUMBER OF LIST DOC
	CUSRC1,	0	/DOCUMENT NUMBER OF LIST DOC	
	CUSLDN	/LIST DOCUMENT NAME
		205	/TEXT TO DISPLAY ON LINE 2 COLUMN 5
	CUSRC4,	0	/SPEC DRIVE NUMBER
	CUSRC3,	0	/SPEC DOC NUMBER
	CUSSDN	/SPEC DOCUMENT NAME
		305	/TEXT TO DISPLAY ON LINE 3 COLUMN 5
	CUSRC6,	0	/RESULT DRIVE NUMBER
	CUSRC5,	0	/RESULT DOC NUMBER
	CUSRDN	/RESULT DOCUMENT NAME

		405
		NUMKEY	/NUMBER OF KEY FIELDS WE WILL SORT ON

	CIFMNU
	JMS I IOACAL
		0
		TYPGO	/TEXT STRING TYPE GO TO BEGIN SORT
		1505
	JMS PRETURN	/AND PRESS RETURN
	JMS ORGOLD	/OR PRESS GOLD M
		ORAR
CUSGO1,									/A029
	AC0002		/SET AC TO 2 SO MENU WILL PROCESS GO PROMPT
	JMS READMU
		JMP CUSR1	/RETURN TO MM
	CDFMYF		/SET DATA FIELD TO MY FIELD
	SPA CLA		/TEST FOR NEGATIVE AC
	JMP GNMEAN	/IF NEGATIVE RESPONSE WAS INAPPRIPRIATE SO COMPLAIN
			/ELSE CONTINUE		
/									/A015
/ IF THE OPERATOR SPECIFIED 'O' TO OVERWRITE THE OUTPUT DOCUMENT	/A015
/  THEN WE MUST DELETE ALL DOCUMENT BLOCKS FROM THE ALLOCATION BLOCK	/A015
/   ASSOCIATED WITH THAT OUTPUT DOCUMENT				/A015
/ OTHERWISE THE SORT COULD RUN OUT OF 'SCRATCH' DISK SPACE		/A015
/  AND A 'DISK ERROR UNIT n' WOULD OCCUR				/A015
/									/A015
TOSORT,	TAD	(3000)		/					/A015
	AND	DSKID		/ mask the 'T', 'B', AND 'O' MODE	/A015
	TAD	(-3000)		/					/A015
	SZA CLA			/ SKIP NEXT IF 'O'			/A015
	JMP	SORT		/ JMP BECAUSE 'T' OR 'B'		/A015
	TAD	SOTFL	/that	/ OUTPUT DOCUMENT # AND DRIVE #		/A015
	MQL		/is	/ INTO THE MQ FOR THE 'XDSKIN'		/A015
	AC7777		/all	/ -1 MEANS SET FOR 'OVERWRITE'		/A015
	CIFFIO		/there	/					/A015
	FILEIO		/is	/ OPEN the document			/A015
	XDSKIN		/to	/					/A015
	CIFFIO		/it	/ 					/A015
	FILEIO		/boo-	/ CLOSE the document			/A015
	XDSKCL		/bie	/					/A015
SORT,	CDFSRT			/CHANGE TO SORT FIELD
	TAD I (PARSELIST)	/GET THE ADDRESS OF SELECTER ROUTINE
	DCA T1			/STORE IT IN T1
	CDFMYF
	TAD CUSRCM		/TO PASS THE RETURN POINT IN AC TO SELECTOR

	CDISRT			/INSTRUCTION FIELD TO SORT FIELD
	DCA MMRETURN		/STORE IN A LOCATION IN SORT FIELD
	JMP I T1		/JUMP TO SELECTER


GNMEAN,	JMS MVINPT		/COPY INPUT FROM MENU TO INBUF
	JMS NOMEAN		/COMPLAIN ABOUT INCORRECT INPUT
	JMP CUSGO1		/ASK AGAIN				/C029




	PAGE


/ROUTINES TO DISPLAY COMMON PROMPTS ON THE SCREEN


DSORT,	XX	
	CIFMNU
	JMS I IOACAL
		0
		SRT
		0
	JMP I DSORT


/CALLED BY JMS ORGOLD
/		VALUE FOR FIRST WORD ARGUMENT (EITHER ORAR FOR OR  PRESS GOLD
/					      M OR NARG FOR PRESS GOLD M)

ORGOLD,XX		/DISPLAYS (OR) PRESS GOLD M TO RECALL MENU
	CLA
	TAD I ORGOLD
	DCA FWARG	/STORE ARGUMENT IN FIRST WORD ARGUMENT	
	ISZ ORGOLD
	/NOTE AC MUST BE 0 HERE TO ENSURE GTDKID WILL READ SYSTEM FLOPPY
	JMS GTDKID	/READ SYSTEM DISKETTE ID
	TAD DSKNO	/ADD TO PREVIOUS ID #
	SZA CLA		/IF EQUAL  SYSTEM DISKETTE HAS NOT BEEN REMOVED
	JMP SDOUT	/AC NOT 0 SYSTEM DISKETTE WAS REMOVED
OGOLD1,CIFMNU
	JMS I IOACAL
		0
		DOGM		/ADDRESS OF OR TYPE GOLD M TO RECALL MENU
		2505		/POSITION OF LINE
		FWARG,	0	/FIRST WORD OF PROMPT EITHER "OR" OR " "
	JMP I ORGOLD	/RETURN TO CALLER	
SDOUT,
			/THIS IS TO SEE OF GOLD M MESSAGE IS DISPLAYED WITH
			/OR OR  NOT IF IT IS THEN REPLACE MESSAGE WILL BE
			/ALSO PRECEDED WITH AN OR ALSO
	TAD FWARG	/GET CONTENTS OF FWARG
	CIA		/NETATE IT
	TAD (NARG)	/SEE IF IT IS NARG
	SZA CLA		/IF IT IS CONTINUE
	JMP CHARG	/IF NOT NARG CHANGE FIRST WORD OF REPLACE MESSAGE
	TAD (NARG)	/IF NARG SET FIRST WORD ARGUMENT OF REPLACE MESSAGE TO
	DCA SDFW	/NULL
SDOUT1,	TAD (AARG)	/PUT ARGUMENT FOR AND IN FIRST WORD ARGUMENT OF GOLD
	DCA FWARG	/M PROMPT SO WILL DISPLAY AND PRESS GOLD M
	JMS RSDSK	/GO DISPLAY REPLACE SYSTEM DISK PROMPT
	JMP OGOLD1	/GO DISPLAY AND PRESS GOLD M
CHARG,	TAD (ORAR)
	DCA SDFW	/MAKE OR FIRST WORD OF REPLACE MESSAGE
	JMP SDOUT1
/VERIFIES USER INSERTS INITIALIZED DOCUMENT FLOPPY INTO DRIVE WHEN
/REPLACING A FLOPPY DUE TO SPACE PROBLEMS
/CALLED BY JMS DDCHK;ERROR RETURN;OK RETURN
/AC 0 ON RETURN
DDCHK,	XX
DDCHK1,	JMS ERASE
	CLA
	TAD CUSRC6	/MAKE AC EQUAL TO RESULT DRIVE
			/SO GTDKID READS FLOPPY IN APPROPRIATE DRIVE
	JMS GTDKID	/READ HOME BLOCK INTO CUB1
	CLA CLL		/GTDKIT RETURNS WITH DISKETTE ID IN AC SO CLEAR
/	TAD CUB1+0	/GET WORD 0 OF HOME BLOCK			/D014
/	TAD (-7401)	/ADD NEGATIVE OF VALUE IT SHOULD BE		/D014
/	SZA CLA		/IF 0 CONTINUE CHECK				/D014
/	JMP DDERR	/ELSE TELL USER DISKETTE IS NOT VALID		/D014
/	TAD CUB1+1	/GET WORD 1 (BLOCK TYPE) OF HOME BLOCK		/D014
/	AND (0070)	/ISOLATE BITS 6-8				/D014
/	CLL RTR		/CLEAR LINK AND 				/D014
/	RAR		/MOVE TO BITS 9-11				/D014
/	TAD (-3)	/ADD NEGATIVE OF VALUE IT SHOULD BE		/D014
/	SZA CLA		/IF 0 CONTINUE CHECKING				/D014
/	JMP DDERR	/ELSE TELL USER DISKETTE IS NOT VALID		/D014
	TAD CUB1+6	/GET BLOCK NUMBER OF HOME BLOCK
	TAD (-DLALOC)	/ADD NEGATIVE OF VALUE IT SHOULD BE
	SZA CLA		/IF 0 RETURN TO USER
	JMP DDERR	/ELSE TELL USER DISKETTE IS NOT VALID
	ISZ DDCHK	/INCREMENT FOR OK RETURN
	TAD (500)	/ERASE SCREEN
	JMS ERASE	/BEFORE CONTINUING
	CLA
DCHKXT,	JMP I DDCHK	/RETURN AND CONTINUE


DDERR,	JMS ERASE
	JMS DSORT
	JMS DERCKW	/ CHECK FOR WINCHESTER DRIVE			/A030
	CIFMNU
	JMS I IOACAL
		0
		DERR	/ INVALID DISKETTE MESSAGE
		505
	DERST1, 0000	/ ADDR OF SUBSTRING - SET BY DERCKW		/A030
		CUSRC6	/ RESULT DOC DRIVE NUMBER
	DERST2, 0000	/ ADDR OF SUBSTRING - SET BY DERCKW		/A030
		605
	DERST3, 0000	/ ADDR OF SUBSTRING - SET BY DERCKW		/A030
	JMS PRETURN
	JMS ORGOLD
		ORAR
	JMS KBRD	/READ INPUT
	CLA		/USER PRESSED RETURN SO
	TAD (RXERT	/TO TELL SYSTEM TO FORGET INDEX INFORMATION
	DCA QUQBLK+RXQFNC	/BECAUSE USER WILL PUT IN NEW FLOPPY
	JMS QURX
	CLA		/THIS ERASES ANY ERROR RETURN FROM QURX

	JMP DCHKXT	/USER PRESSED RETURN GO ASK FOR RESULT AGAIN

	PAGE

	
/DISPLAYS THAT RESULT DOC IS ALREADY IN USE.
/CALLED BY
/	JMS LCKMSG
/		NON ERROR RETURN CONTINUES
/		ERROR RETURN PROMPTS FOR RESULT AGAIN
/TEST FOR REMOVAL OF SYSTEM FLOPPY, IF IT HAS BEEN REMOVED SURPRESS LOCK ERROR
/MESSAGE BECAUSE DOCUMENTS ARE NOT THE SAME
LCKMSG,	XX							       /M007
	JMS GTDKID	/GET DISKETTE ID NOTE AC 0 HERE			A007
	TAD DSKNO	/GET CURRENT SYSTEM DISKETTE ID			A007
	SZA CLA		/HAS DISKETTE BEEN REMOVED			A007
	JMP LOKRTN	/YES RETURN TO CALLER WITHOUT DISPLAYING ERROR	A007
			/ELSE DISPLAY LOCK ERROR MESSAGE
	TAD (2205)	/ERASE GOLD M PROMPT
	JMS ERASE
	CIFMNU
	JMS I IOACAL
	0
	SRLCKER		/TEXT STRING DOC ALREADY IN USE
	2205
	IFDEF FRENCH < 141 > /L.G.A.
	BELTXT		/RING BELL
	CUSRC6		/RESULT DOC DRIVE NUMBER			M007
	CUSRC5		/RESULT DOC NUMBER				M007
	CUSRDN		/RESULT DOC NAME				M007
	CIFMNU
	JMS I IOACAL
	0
	TARTN
	2405
	JMS RTNWT	/READ INPUT AND WAIT FOR RETURN
	JMP LCKMSG	/IF NOT RETURN REDISPLAY COMPLAINT
	TAD (2205)	/RETURN WAS TYPED ERASE COMPLAINT
	JMS ERASE	
	ISZ LCKMSG	/INCREMENT FOR ERROR RETURN
LOKRTN,	JMP I LCKMSG	/RETURN TO CALLER



/CALLED BY JMS GMTST;GOLD M;GOLD KEY NOT GOLD M

GMTST,	XX		/TEST IF KEY IN GOLD KEY.  IF GOLD M GOES TO MM
			/IF GOLD KEY NOT GOLD M DISPLAYS WHEN TYPING TO MENU
			/ERROR MESSAGE. ASSUMES THAT CHARACTER IS IN AC
GMTST1,	TAD (-EDMENU)	/SEE IF GOLD M
	SNA CLA		/IF AC = 0 	
	JMP CHKIT	/GO SEE IF SYSTEM FLOPPY IS IN
			/ELSE RING BELL AND OUTPUT WHEN TYPING TO MENU ERROR
			/MESSAGE
GMERDSP,			/
/d025	TAD (2205)	/ERASES BEFORE DISPLAYING NEXT			/d025
/d025	JMS ERASE	/						/d025

	JMS RBELL	/
/d025	CIFMNU		/						/d025
/d025	JMS I IOACAL	/						/d025
/d025	0		/						/d025
/d025	TRYAGN		/						/d025
/d025	2205		/						/d025
/d025	2305		/						/d025
/d025	2405		/						/d025
/d025	IFDEF FRENCH < 153 > /L.CLFX.E					/d025
/d025	2605		/						/d025
/d025	IFDEF CANADA < 141 > /L.G.A.					/d025
/d025	IFDEF FRENCH < 141 > /L.G.A.					/d025
/d025	JMS RTNWT	/WAIT FOR RETURN				/d025
/d025	JMP GMERDSP	/NOT RETURN DISPLAY COMPLAINT AGAIN		/d025
/d025	TAD (2205)	/ERASE SCREEN, RETURN TO CALLER, ASK AGAIN	/d025
/d025	JMS ERASE	/						/d025
GMRTN2,	ISZ GMTST	/GOLD KEY NOT GOLD M RETURN	
GMRTN1,	JMP I GMTST	/GOLD M RETURN


CHKIT,	
/AC MUST BE 0 HERE TO ENSURE GTDKID READS SYSTEM FLOPPY
	JMS GTDKID	/GO READ DISKETTE ID
	TAD DSKNO	/ADD CURRENT DISKETTE ID
	SNA CLA		/IF ZERO SAME DISKETTE IS IN SO
	JMP GMRTN1	/SET FOR GOLM RETURN
	JMS RBELL	/ELSE RING BELL
	JMS RSDSK	/FLASH REPLACE SYSTEM FLOPPY DISPLAY
	CDFMYF
	CIFMNU
	JMS I INACAL
		INBUF
		JMP GMTST1
		JMS RBELL
		JMP CHKIT

/ SUBROUTINE TO DISPLAY: 'TYPING "" HAS NO MEANING HERE'
/ CALLED BY:	JMS NOMEAN; RETURN PC (and read input again)

NOMEAN,	XX		/ COSMETIC display mods		 	/M0018
NOMNDSP,JMS RBELL	/ RING BELL
/d025
/d025    IFDEF ENGLSH <						/A011
/d025	CLA		/ TRUNCATE STUFF BETWEEN QUOTES		/A011
/d025	DCA I (INBUF+14)/ SO MESSAGE WILL FIT ON 1 LINE		/A011
/d025			/ end 'ifdef english'			/A011 >
/d025
/d025    IFDEF FRENCH <						/A011
/d025	CLA							/A011
/d025	DCA I (INBUF+14)					/A011
/d025			/ end 'ifdef french'			/A011 >
/d025
/d025	CIFMNU		/ DISPLAY: 'TYPING "" HAS NO MEANING HERE'
/d025	JMS I IOACAL
/d025	  0
/d025	  NMEAN
/d025	  -2700		/ LINE 27 COLUMN 0			/M011
/d025
/d025    IFNDEF DUTCH <						/A011
/d025	INBUF+1		/ WE NEED THE +1 TO MOVE ONE ADDRESS BEYOND
/d025			/ THE -BUFFER SIZE IN FIRST LOCATION
/d025			/ end 'ifndef dutch'			/ >
/d025
/d025    IFDEF CANADA < 141 > / L.G.A.
/d025    IFDEF FRENCH < 141 > / L.G.A.
/d025
/d025	JMS	RTNWT	/ WAIT FOR RETURN
/d025	JMP	NOMNDSP	/ NO RETURN COMPLAIN AGAIN
/d025	TAD	(2605)	/ RETURN SO ERASE SCREEN
/d025	JMS	ERASE	/
	CLA		/						/a025
	JMP I	NOMEAN	/ RETURN TO CALLER TO ASK AGAIN


NDERR,	XX
	TAD I NDERR	/PICK UP DOC NAME
	DCA DCNAM	/STORE IT FOR ERROR MESSAGE

	ISZ NDERR	/INCREMENT FOR RETURN
	CDFMNU		/CHANGE TO MENU FIELD
	TAD I (MUBUF+MNDRV)	/PICK UP DRIVE NUMBER
	CDFMYF		/CHANGE BACK TO MY FIELD
	DCA DCRV	/STORE IN DRIVE NUMBER FOR ERROR MESSAGE
	TAD (2205)
	JMS ERASE
	JMS	NDERCW	/ CHECK FOR WINCHESTER DRIVE			/A030
NDDSP,	CIFMNU
	JMS I IOACAL
	0
	NDOC
	2205
NDSTR,	0000		/ ADDR OF SUBSTRING "DRIVE-DEVICE		/A030
DCRV,	0000
DCNAM,	0000
	CIFMNU
	JMS I IOACAL
	0
	TARTN
	2505
	JMS RTNWT	/WAIT FOR RETURN
	JMP NDDSP	/NOT RETURN COMPLAIN AGAIN
	TAD (2205)	/RETURN ERASE SCREEN
	JMS ERASE
	JMP I NDERR	/AND CONTINUE



/ CHECK FOR WINCHESTER DRIVE						/A030

NDERCW,	XX								/A030
	CLA		/ CLEAR AC					/A030
	CDFMNU		/ MENU FIELD					/A030
	TAD MUBUF+MNOPTN	/ OPTION WORD				/A030
	CDFMYF		/ BACK TO THIS FIELD				/A030
	DCA	NDOPTN	/ SAVE VALUE					/A030
	AC0004		/ MASK - WINCHESTER DRIVE			/A030
	AND	NDOPTN	/ IS WINNIE BIT SET ?				/A030
	SNA	CLA	/ YES - SKIP AND CONTINUE			/A030
	JMP	NDCTD	/ NO - INSERT TEXT "DRIVE			/A030
	TAD	DCRV	/ CK FOR DRIVE 0				/A030
	SNA		/ NO - SKIP AND CONTINUE			/A030
	JMP	NDCTD	/ YES - INSERT TEXT "DRIVE			/A030
	TAD	(-1	/ CK FOR DRIVE 1				/A030
	SZA	CLA	/ YES - SKIP AND CONTINUE			/A030
	JMP	NDCTW	/ NO - INSERT TEXT "DEVICE			/A030
	AC0010		/ MASK - VOLUME ASSIGNED TO 1			/A030
	AND	NDOPTN	/ IS VOLUME ASSIGNED TO 1			/A030
	SNA	CLA	/ YES - SKIP AND INSERT "DEVICE			/A030
	JMP	NDCTD	/ NO - INSERT TEXT "DRIVE			/A030
NDCTW,	TAD	(SRDEV)	/ ADDR OF TEXT "DEVICE				/A030
	DCA	NDSTR	/ INTO PARAMETER LIST				/A030
	JMP	NDCWEX	/ BRANCH TO EXIT				/A030
NDCTD,	TAD	(SRDRV)	/ ADDR OF TEXT "DRIVE				/A030
	DCA	NDSTR	/ INTO PARAMETER LIST				/A030
NDCWEX,	JMP I	NDERCW	/ RETURN					/A030
NDOPTN,	0		/ OPTION WORD					/A030

	PAGE

/ READ FROM KEYBOARD

/ CALLED BY: JMS KBRD; RETURN TYPED
		
KBRD,	XX		/COMPARE IS DESIRED CALLED WITH 0 IN AC
KBRD1,	CDFMYF	
	CIFMNU
	JMS I INACAL	/ CALL INA TO READ INPUT
	  INBUF		/ LOCATION TO RECEIVE INPUT
	  JMP	GOLDTST	/ PROCESS GOLD KEY
	CLA MQA		/ MQ CONTAINS #CHARS IN BUFFER
	SNA CLA		/ IF THIS IS 0 RETURN WAS TYPED
	JMP I	KBRD	/ GO BACK TO CALLER
	JMS	NOMEAN	/ ELSE MUST BE INAPPROPRIATE RESPONSE COMPLAIN
	JMP	KBRD1	/ ASK AGAIN
GOLDTST,JMS	GMTST	/ GO READ GOLD KEY
	JMP	CUSR1	/ GOLD MENU RETURN
	JMS	PRETURN	/ DISPLAY PRESS RETURN				A007
	JMS	ORGOLD	/ DISPLAY OR PRESS GOLD M			A007
	  ORAR		/						A007
	JMP	KBRD1	/ READ INPUT AGAIN NOT GOLD MENU	


/ CALLED WITH 0 OR 1 IN AC TO DETERMINE
/  FROM WHICH FLOPPY THE 'HOME' BLOCK
/   WILL BE READ
	
GTDKID,	XX
	JMS	CUPDRS
	TAD	(CUB1)	/ BUFFER ADDRESS
	DCA QUQBLK+RXQBAD
	TAD	(RXBDIR)/ BLOCK TO READ (HOME BLOCK)
	DCA QUQBLK+RXQBLK
	TAD	(RXEDN)	/ TELL QURX TO 'get density'			/A0020
	DCA QUQBLK+RXQFNC						/A0020
	JMS	QURX	/						/A0020
	CLA		/						/A0020
	TAD	(RXERD)	/ TELL QURX TO 'read'
	DCA QUQBLK+RXQFNC
	JMS	QURX
	CLA		/ THIS CLOBBERS ANY QURX ERROR RETURN
	TAD	CUB1+5	/ INDEX TO FIFTH WORD (DISKETTE ID#)
	JMP I	GTDKID	/ EXIT WITH CURRENT DISKETTE ID IN AC



/SEE IF PRINTER IS BUSY BEFORE TELLING USER TO REMOVE FLOPPY

PTRCHK,	XX
	CLA
	CDFPRT		/CHANGE DATA FIELD TO PRINTER FIELD
	TAD I (PRSTTS)	/GET PRINTER STATUS WORD
	CDFMYF		/CHANGE DATE FIELD BACK TO MINE
	SNA CLA		/IF NOT ZERO COMPLAIN
	JMP I PTRCHK	/ELSE RETURN TO CALLER AND CONTINUE
PTRMSG,	JMS ERASE
	CIFMNU		/DISPLAY PRINTER IS BUSY MESSAGE
	JMS I IOACAL
		0
		PTRBUS
		505
		605
	JMS ORGOLD		/DISPLAY PRESS GOLD M FOR MM
		NARG
	JMP INPUT		/READ INPUT

/HERE FOR SPACE REASONS							M007
NEWLN,	XX		/						A007
	CDFMYF		/						A007
	CIFMNU		/						A007
	JMS I IOACAL	/ CALL IOA OUTPUT ROUTINE			A007
	0		/ ADDRESS OF OUTPUT ROUTINE			A007
	ASTRING		/						A007
	CRLF		/ STRING FOR CAR RETURN  LINEFEED		A007
	JMP I NEWLN	/						A007



TOSMALL, XX
	JMS	TOSCKW	/ CHECK FOR WINCHESTER				/A030
	CDFMYF
	CIFMNU		/CHANGE INSTRUCTION FIELD TO MENU FIELD
	JMS I IOACAL	/GO DISPLAY NOT ENOUGH ROOM SPECIFY ANOTHER DRIVE
		0
		TSMALL		/ADDRESS OF FIRST PROMPT
		505		/DISPLAY FIRST PROMPT ON LINE 5 COLUMN 5
	TSSTRA, 0000		/ ADDR OF SUBSTRING			/A030
		CUSRC6		/RESULT DRIVE NUMBER
		605
	JMP I TOSMALL

/EXIT ROUTINE WHICH UNLOCKS DOCUMENTS BEFORE GOING TO MM	

CUSR1,	JMP RETMNU							/M027



/CALLS MENU TO READ INPUT TO DOC PROMPTS, TOA AND GO PROMPTS
/CALLED BY:

	/JMS READMU
	/	GOLD M	 DATA FIELD SET TO MY FIELD
	/	CONTINUE PROCESSING DATA FIELD SET TO MENU FIELD
READMU,	XX
	CDFMNU
	DCA I (MUBUF+MNTMP4)   /SET TMP4 FOR APPROPRIATE FUNCTION
READLP,	CDFMYF			/SET DATA FIELD TO MENU			/M027
	CIFMNU;JMS I MNUCAL;DLMSR1	/CALL MENU
	CDFMNU				/CHANGE DATA FIELD TO MENU
	TAD I (MUBUF+MNTMP3)		/GET AND TEST CONTENTS OF TMP3
	SZA	/IF 0 THEN GOLD KEY WAS PRESSED
	JMP RDRTN2	/NOT GOLD KEY SO RETURN AND PROCESS INPUT
	TAD I (MUBUF+MNSYSA)	/WAS GOLD KEY TO GET IT
	TAD (4000)		/SET FIRST BIT TO 1 BECAUSE MENU STRIPS IT OFF
	CDFMYF			/CHANGE DATA FIELD TO MINE
	JMS GMTST		/PROCESS GOLD KEY
		JMP RDRTN1	/GOLD M RETURN
/d025	JMS	PRETURN		/DISPLAY PRESS RETURN		/A007	/d025
/d025	JMS	ORGOLD		/DISPLAY OR PRESS GOLD M	/A007	/d025
/d025		ORAR		/				/A007	/d025
	JMP	READLP		/GOLD GARBAGE, READ INPUT AGAIN		/M027
RDRTN2,	ISZ READMU		/GOLD M EXIT
RDRTN1,	JMP I READMU		/CONTINUE EXIT

/COPIES INPUT FROM MENU FIELD TO INBUF FOR NO MEANING PROMPT
MVINPT,	XX
	CLA
	JMS CUCOPY	/GO COPY INPUT FROM MENU FIELD TO INBUF
	MUISTR		/ADDRESS OF FROM FOR CUCOPY
	CDFMNU		/DATA FIELD OF FROM
	INBUF+1		/ADDRESS OF FOR FOR CUCOPY
	CDFMYF		/CHANGE DATA FIELD TO MINE
	STRLEN		/NUMBER OF WORDS TO COPY (STANDARD)
JMP I MVINPT		/RETURN TO CALLED
	

	PAGE	


/ PARSE A SPECIFICATION DOCUMENT FOR SORT AND LOAD THE RESULT INTO MEMORY
/
PARSE,	.
	DCA SPECNO		/AJF PUT SPEC DRIVE & DOC FROM AC INTO SPECNO
	DCA	DEADKEY		/ CLEAR DEADKEY FLAG
/	TAD (-KVTWIDTH); DCA VTWIDTH /SET LINE WIDTH FOR DISPLAY ROUTINE D007
/INITIALIZE FIELD NAME COUNTER MAXIMUM FIELD SIZE		M007
	DCA NUMKEY		/SET KEY FIELD COUNTER TO ZERO      A007
	AC4000			/SET AC TO 4000			A007
	DCA ORDWD		/SET FIRST BIT OF ORDWRD TO 1	A007
	DCA FTYPE		/SET FIELD NAME TYPE TO 0	A007
/ SETUP INTO AUTO INDEX #12
/
	AC7777
	CDFSRT			/CHANGE DATA FIELD TO SORT FIELD	A007
	TAD I (SDFNBUFFER)	/GET LOCATION OF BUFFER 		M007
	CDFMYF			/CHANGE DATA BACK TO MY FIELD		A007
	DCA A12
	TAD (-FNSIZE-1); DCA FNCOUNT

	JMS ERASE		/ERASE SCREEN				A008
	JMS DSORT		/DISPLAY SORT				A008
	CIFMNU
	JMS I IOACAL		/CALL IOA
	0			/ADDRESS OF OUTPUT ROUTINE
	HC			/TEXT STRING TO POSITION CURSOR ON LINE 3 M008
	0100			/SET TO LINE 3 SO THERE IS ROOM FOR 12 LINES
				/OF SPEC DOC AND ERROR MESSAGES
/
/OPEN THE FILE FOR READING
/
	TAD SPECNO; CIFFIO; FILEIO; XRDFIN				/M0010

/LOOKING FOR THE TEXT STRING:
/
/	'SORT ON <FIELD NAME> IN ASCENDING ORDER'
/
/OR:	'SORT ON <FIELD NAME> IN DESCENDING ORDER'
/
/ WITHIN THE SORT SELECTION SPECIFICATION DOCUMENT
/
STPARS,	JMS TXTCOM; MSORTON; ERR001
/ PARSE THE <FIELD NAME> FROM THE SPECIFICATION DOCUMENT
/
/GET A CHARACTER FROM THE SPEC DOC - *** ERR001 IF NO MORE
/
	CLA; JMS RD1CHR; ERR001
/ TEST CHARACTER FOR '<' LEFT ANGLE BRACKET *** ERR001 IF NOT
/ (AC) = CHARACTER FROM 'JMS RD1CHR'
/
	TAD (-74); SZA CLA; ERR001
	JMP GETFNCHAR


DONE,
	CLA
	AC7777			/SET AC TO -1
	CDFSDFN			/CHANGE DATA FIELD TO 'SDFN' FIELD 	       /A007/M014
	DCA I A12		/WRITE -1 BUFFER TERMINATOR XSDFN      A007
	CDFMYF			/CHANGE DATA FIELD BACK TO MINE		A007
	JMP I PARSE		/EXIT TO PROMPT FOR LIST DOC

ERR,	XX		/						A007
	CDFMYF			/MAKE SURE DATA FIELD IS MY FIELD	A007
	CIFMNU			/MAKE INSTRUCTION FIELD MENU FIELD	A007
	JMS I IOACAL		/CALL IOA				A007
	0		/						A007
	ASTRING		/						A007
	ACARET			/STRING TO POSITION THE CARET		A007
	JMS NEWLN	/	POSITION THE NEXT LINE			A007
	JMP I ERR		/EXIT					A007

/ CHECK FOR WINCHESTER							/A030

DERCKW,	XX								/A030
	CLA		/ CLEAR AC					/A030
	CDFMNU		/ MENU FIELD					/A030
	TAD MUBUF+MNOPTN	/ OPTION WORD				/A030
	CDFMYF		/ BACK TO THIS FIELD				/A030
	DCA	DEOPTN	/ SAVE VALUE					/A030
	AC0004		/ MASK - WINCHESTER INSTALLED			/A030
	AND	DEOPTN	/ IS WINNIE BIT SET ? 				/A030
	SNA	CLA	/ YES - SKIP AND CONTINUE			/A030
	JMP	DERCT1	/ NO - INSERT TEXT - DISKETTE, DRIVE		/A030
	TAD	CUSRC6	/ CK FOR DRIVE 0				/A030
	SNA		/ NO - SKIP AND CONTINUE			/A030
	JMP	DERCT2	/ YES - INSERT TEXT - DISKETTE,DRIVE,DISK/VOL	/A030
	TAD	(-1	/ CK FOR DRIVE 1				/A030
	SZA	CLA	/ YES - SKIP AND CONTINUE			/A030
	JMP	DERCT3	/ NO - INSERT TEXT - VOLUME,DEVICE,DISK/VOL	/A030
	AC0010		/ MASK - VOLUME ASSIGNED TO 1			/A030
	AND	DEOPTN	/ IS VOLUME ASSIGNED ?				/A030
	SNA	CLA	/ YES - SKIP & INSERT TEXT - VOL,DEV,DSK/VOL	/A030
	JMP	DERCT2	/ NO - GO INSERT TEXT - DSK,DRV,DSK/VOL		/A030

DERCT3,	TAD	(DERVL1)	/ ADDR OF "VOLUME ON DEVICE		/A030
	DCA	DERST1		/ INTO PARAMETER LIST			/A030
	TAD	(DERVL2)	/ ADDR OF "VOLUME			/A030
	DCA	DERST2		/ INTO PARAMETER LIST			/A030
	TAD	(DERDKV)	/ ADDR OF "DISKETTE/VOLUME		/A030
	DCA	DERST3		/ INTO PARAMETER LIST			/A030
	JMP 	DERCEX		/ BBRANCH TO EXIT			/A030

DERCT1,	TAD	(DERDS2)	/ ADDR OF "DISKETTE			/A030
	DCA	DERST3		/ INTO LIST				/A030
	JMP	DERCT4							/A030

DERCT2,	TAD	(DERDKV)	/ ADDR OF "DISKETTE/VOLUME		/A030
	DCA	DERST3		/ INTO LIST				/A030

DERCT4,	TAD	(DERDS1)	/ ADDR OF "DISKETTE IN DRIVE		/A030
	DCA	DERST1		/ INTO LIST				/A030
	TAD	(DERDS2)	/ ADDR OF "DISKETTE			/A030
	DCA	DERST2		/ INTO LIST				/A030

DERCEX,	JMP I	DERCKW		/ RETURN				/A030
DEOPTN,	0000			/ OPTION WORD				/A030
	
	PAGE	


/GETFNCHAR, AC0000; JMS RD1CHR; ERR001
GETFNCHAR, AC7777; JMS RD1CHR; ERR001 				/M003

	MQL			/ TEMP SAVE IT IN THE MQ
	MQA
	TAD	(-76)		/SEE IF '>'
	SNA
	JMP	FNEND		/YES, DONE FIELD
	TAD	(2)		/SEE IF '<'
	SNA
	ERR001			/ '<' FOUND WITHIN <FIELD NAME>
	TAD (2) 		/SEE IF IT IS A : (COLON SIGNIFIES A007
	SZA CLA			/NUMERIC KEY FIELD)			A007
	JMP INCFCTR		/IF NOT A COLON CONTINUE		A007	
	TAD ORDWD		/IF COLON SET APPROPRIATE BIT IN FTYPE	A007
	TAD FTYPE		/A007
	DCA FTYPE		/STORE WORD WITH BIT SET FOR NUMERIC	A007
INCFCTR,TAD	DEADKEY		/ Check for the status of dead keys	/a031
	SNA CLA			/ Is one currently being evaluated?	/a031
	ISZ	FNCOUNT		/ No, SEE IF ROOM			/m031
	SKP
	ERR001			/ <FIELD NAME> EXCEEDED 30(10) CHARACTERS
	MQA	
	CDFSDFN			/CHANGE DATA FIELD TO 'SDFN' FIELD	/A007M014
	DCA I	A12		/AND STORE IN STRING
	CDFMYF			/CHANGE DATA FIELD BACK TO MY FIELD	A007
	JMP	GETFNCHAR	/LOOP BACK FOR MORE
FNEND,	CLA			/					A007
	TAD FNCOUNT		/GET COUNT OF WORDS USED		A007
	TAD (FNSIZE+1)		/COMPARE WITH ORIGINAL BUFFER SIZE	A007

	SNA CLA			/IF EQUAL				A007
	ERR001			/THERE IS AN ERROR ONLY <> FOUND	A007
	CDFSDFN			/CHANGE DATA FIELD TO 'SDFN' FIELD	/A007/M014
	DCA I A12	/ [0]	/THERE ARE CHARACTERS STORE TRAILING 0	A007
	CDFMYF			/CHANGE DATA FIELD BACK TO MY FIELD 	A007
	DCA FNCOUNT		/SET FIELD CHARACTER COUNTER BACK TO 0	A007
				/FOR NEXT FIELD				A007
	ISZ NUMKEY		/INCREMENT KEY FIELD COUNTER		A007

CMPORDER,JMS TXTCOM; MINA; JMP CHKD; JMP CHKETC


CHKD,   CLA
	TAD THCHAR	/GET CHAR TXTCOM STORED
	IFDEF ENGLSH <
	TAD 	(4)		/IS IT A D?
	>
	IFDEF ITALIAN <
	TAD	(4)
	>
	IFDEF V30NOR <
	TAD 	(31)	/IS IT A Y?
	>
	IFDEF V30SWE <
	TAD 	(6)		/IS it an F
	>
	IFDEF DUTCH <
	TAD	(1)
	>
	IFDEF SPANISH <
	TAD 	(4)
	>


	SZA		/IF AC 0 THEN IT IS A D SEE IF NEXT CHAR IS AN E
	ERR001		/ELSE ERROR
CHKE,	JMS TXTCOM; ME; ERR001	
	CLA		/						A007
	TAD ORDWD	/GET ORDER WORD AND COMBINE WITH ORDER 		A007
/FIRST TIME HERE BIT 0 IS SET FOR DESCENDING, NEXT TIME BIT 1 ETC.	A007
	TAD  ORDER	/ADD CONTENTS OF ORDER			A007
	DCA ORDER	/STORE BACK IN ORDER			A007
CHKETC,	JMS TXTCOM; MSCENDING; ERR001
		
/A SUCCESSFUL COMPARISON OF THE TEXT STRING 'ASCENDING ' OR 'DESCENDING '
/HAS BEEN COMPLETED
/SET NEXT BIT IN ORDWD FOR KEY FIELD DESCRIPTOR WORDS ORDER AND FTYPE  A007
CLA CLL
TAD ORDWD	/GET ORDER WORD					A007
RAR		/MOVE BIT ONCE TO RIGHT				A007
DCA ORDWD	/STORE BACK IN ORDER WORD			A007
/THE TEXT STRING 'ORDER' MUST SUFFIX
/
	JMS TXTCOM; MORDER; ERR001  /






/PARSE FOR AND							A007
PSAND,	JMS TXTCOM; MAND; JMP ERRTST  /				A007
	CLA		/SEE IF MAX FIELDS HAVE BEEN SPECIFIED	A007
	TAD NUMKEY	/GET KEY FIELDS SPECIFIED		A007
	TAD (-MXFLD)	/IS MAX = TO NUMBER SPECIFIED		A007
	SNA CLA		/IF AC  0 				A007
	ERR002		/DISPLAY ERROR				A007
	JMP STPARS	/ELSE BEGIN PARSING NEXT LINE		A007


SPECNO,	0000
ORDWD,	0000	/USED TO SET KEY FIELD NAME DESCRIPTOR WORDS	A007
		/ORDER AND FTYPE, 1 IN ORDER MEANS SORT IS DESCENDING 	A007
		/ORDER, AND 1 IN FTYPE MEANS NUMERIC FIELD		A007
		/THIS VARIABLE IS FIRST SET TO 4000 AND THE 1 IN BIT 0	A007
		/IS SHIFTED ONCE TO RIGHT EACH TIME THROUGH PARSER	A007

FNCOUNT,0000

/****************************************************************************
/
/	The next routine has been moved to where OUT2VT was to make	/a031
/	room for changes to the parser for dead key sequence evaluation	/a031
/
/****************************************************************************

/ CHECK FOR WINCHESTER DRIVE						/A030

/d031	TOSCKW,	XX		/ CK FOR WINCHESTER ON SYSTEM			/A030
/d031	CLA		/ CLEAR AC					/A030
/d031	CDFMNU		/ MENU FIELD					/A030
/do31	TAD MUBUF+MNOPTN	/ FECTH OPTION WORD			/A030
/d031	CDFMYF		/ BACK TO THIS FIELD				/A030
/d031	DCA	TSOPTN	/ SAVE VALUE					/A030
/d031	AC0004		/ MASK - WINCHESTER INSTALLED			/A030
/d031	AND	TSOPTN	/ IS WINNIE BIT SET ?				/A030
/d031	SNA	CLA	/ YES - SKIP AND CONTINUE			/A030
/d031	JMP	TSCTD1	/ NO - INSERT TEXT "DRIVE" ONLY			/A030
/d031	TAD	CUSRC6	/ CK FOR DRIVE 0				/A030
/d031	SNA		/ NO - SKIP & CONTINUE				/A030
/d031	JMP	TSCTD2	/ YES - GO INSERT "DRIVE/DEVICE"		/A030
/d031	TAD	(-1	/ CK FOR DRIVE 1				/A030
/d031	SZA	CLA	/ YES - SKIP & CONTINUE				/A030
/d031	JMP	TSCTW	/ NO - INSERT "VOLUME ON DEVICE			/A030
/d031	AC0010		/ MASK - VOLUME ASSIGNED TO 1			/A030
/d031	AND	TSOPTN	/ IS VOLUME ASSIGNED				/A030
/d031	SNA	CLA	/ YES - SKIP & INSERT "VOLUME ON DEVICE		/A030
/d031	JMP	TSCTD2	/ NO - GO INSERT "DISKETTE ON DRIVE		/A030

/d031	TSCTW,	TAD	(DERVL1)	/ ADDR OF "VOLUME ON DEVICE		/A030
/d031	DCA	TSSTRA	/ INTO PARAMETER LIST				/A030
/d031	TAD	(TSDEV)	/ ADDR OF "DRIVE/DEVICE				/A030
/d031	DCA	NWSTR	/ INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE	/A030
/d031	JMP	TSCKEX	/ BRANCH TO EXIT				/A030

/d031	TSCTD1,	TAD	(SRDRV)	/ ADDR OF "DRIVE				/A030
/d031	DCA	NWSTR	/ INTO LIST - "SPECIFY ANOTHER DRIVE		/A030
/d031	JMP	TSCTD3	/						/A030

/d031	TSCTD2,	TAD	(TSDEV)	/ ADDR OF "DRIVE/DEVICE				/A030
/d031	DCA	NWSTR	/ INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE	/A030
/d031	TSCTD3,	TAD	(DERDS1)	/ ADDR OF "DISKETTE IN DRIVE		/A030
/d031	DCA	TSSTRA	/ INTO LIST					/A030
/d031	TSCKEX,	JMP I	TOSCKW	/ RETURN					/A030
/d031	TSOPTN,	0000		/ OPTION WORD					/A030

	PAGE


/BEFORE YOU START TEARING YOUR HAIR OUT I WILL EXPLAIN 		A007
/EVERYTHING YOU ARE AFRAID TO ASK ABOUT THE FOLLOWING FEW	A007
/LINES OF CODE.  WE ARE HERE BECAUSE OF A TEXT COMPARISON	A007
/FAILURE.  THE CATCH IS THERE ARE TWO EXITS OUT OF TXTCOM	A007
/IF THERE ARE NO MORE CHARACTERS IN THE SPEC DOC AND IF		A007
/THERE IS A MATCH FAILURE WITH THE CONTENTS OF SPEC DOC		A007
/AND THE WORD 'AND'.  IF THERE ARE NO MORE CHARACTERS IN SPEC 	A007
/DOC THE VARIABLE THCHAR IS NOT UPDATED SO IT STILL CONTAINS	A007
/THE R FROM THE WORD ORDER FROM LAST TXTCOM CALL. SO TO		A007
/DETERMINE IF WE ARE EXITING BECAUSE IT IS END OF SPEC DOC	A007
/I TEST FOR AN R.  THE VARIABLE THCHAR CONTAINS THE NEGATIVE	A007
/VALUE OF THE LAST CHARACTER. THIS SEEMED EASIER THAN REWRITING A007
/PARSER.							A007

ERRTST,	CLA		/SEE WHAT KIND OF ERROR			A007
	TAD THCHAR	/SEE IF THCAR IS UPDATED IF NOT DONE	A007
	IFDEF ENGLSH <
	TAD 	(22)	/SEE IF LAST CHAR READ FROM SPEC IS R	A007
	>
	IFDEF V30NOR <
	TAD 	(5)
	>
	IFDEF ITALIAN <
	TAD 	(5)
	>
	IFDEF V30SWE <
	TAD 	(7)
	>
	IFDEF DUTCH <
	TAD	(5)
	>
	IFDEF SPANISH <
	TAD	(5)
	> 

	SZA CLA		/IF IT IS WE ARE DONE			A007
	ERR002		/ELSE JUST AN ORDINARY ERROR		A007
	JMP DONE



/ NOTE THAT (AC) = 0 HERE NATURALLY
/
/	JMS RD1CHR; SKP		/TRY TO GET ANOTHER CHAR FROM THE SPEC DOC
/	ERR002			/CALL ERROR 2 SPEC DOC TOO BIG
/
/THE SORT SELECTION SPECIFICATION DOCUMENT HAS BEEN PARSED SUCCESSFULLY
/
ERR2,	JMS ERR		/POSITION CARET UNDER TEXT			A007
	CIFMNU		/						A007
	JMS I IOACAL	/DISPLAY ERROR MESSAGE				A007
	0		/						A007
	FSERR		/DISPLAY # FIELDS SPECIFIED			A007
NUMKEY,	0000		/NUMBER OF KEY FIELDS SPECIFIED			A007
	JMS NEWLN	/CARRIAGE RETURN LINE FEED			A007
	CIFMNU		/CHANGE INSTRUCTION FIELD TO MENU		A007
	JMS I IOACAL	/						A007
	0		/						A007
	FSER2		/NEXT LINE OF PROMPT				A007
	JMS NEWLN	/POSITION ON NEXT LINE				A007
	CIFMNU		/						A007
	JMS I IOACAL	/						A007
	0		/						A007
	PRCON		/PRESS RETURN TO CONTINUE			A007
	JMS ORGOLD	/						A007
		ORAR	/						A007
	JMS KBRD	/Return was typed				/A013
	JMP DONE	/Exit parser					/A013

ERR1,	JMS ERR		/						A007
	CIFMNU		/						A007
	JMS I IOACAL	/						A007
	0		/						A007
	MWHAT			/THIS OUTPUT ROUTINE ASSUMES SPEC DOC 	A007
IFDEF CANADA < 141 >  /L.G.A.	/WON'T EXCEED 12 LINES
IFDEF FRENCH < 141 >  /L.G.A.
	JMS ORGOLD	/						A007
		NARG	/						A007

/D026	IFDEF WS102 <
/D007	JMS ULKSUB; SPECNO; CDFMYF
/D026		>	/END IFDEF WS102

JMP INPUT		/READ INPUT					A008



/ THE SORT SPECIFICATION DOCUMENT HAS BEEN PARSED OK
/
/ THE <FIELD NAME> RESIDES WITHIN 'SDFNBUFFER'
/
/ READ A CHARACTER FROM THE SPECIFICATION DOCUMENT (OR THE DOCUMENT OPENED)
/
/	JMS RDNXCH; EOF RETURNS TO HERE; OK RETURNS TO HERE
/
RDNXCH,	.; CLA; CIFFIO; FILEIO; XRDFNC					/M0010
	SPA; CLA			/ Treat read errors like E-O-F.	/A0016
	SZA
	ISZ	RDNXCH
	JMP I RDNXCH

/SUBROUTINE TO READ IN A CHARACTER FROM THE SPECIFICATION DOCUMENT
/AND EXIT WITH IT IN THE AC
/
/ AC AT ENTRY = 0: IGNORE ALL BLANKS, TABS, RULERS, FUNNY SPACES AND <LF>'S
/ AC AT ENTRY =-1: IGNORES ONLY: RULERS, FUNNY SPACES AND LINE FEEDS
/
/CALLED WITH AC=0 OR AC=-1:
/	JMS	RD1CHR
/EOF RETURN (AC UNDEFINED)
/NORMAL RETURN (AC CONTAINS CHARACTER)
/
RD1CHR,	0
	DCA	RDFLAG		/SAVE FLAG
RDNEXT,	JMS	RDNXCH		/GET A CHAR
	JMP I	RD1CHR		/ *** DISK EOF - EXIT ***
	DCA	CHARIN		/SAVE CHAR ( *** INCLUDING MODE BITS *** )
	TAD	CHARIN
	AND	P177		/STRIP OFF MODE BITS
	TAD	(-41)		/ IS IT A PRINTABLE CHARACTER ?
	SPA
	JMP	NPC		/ NON PRINTABLE CHARACTER
	TAD	(41)		/GET BACK PRINTABLE CHARACTER
	JMS	OUT2VT		/AND OUTPUT TO THE SCREEN
	ISZ	RD1CHR		/ +1 TO RETURN ADDRESS
	JMP I	RD1CHR		/AND EXIT

/NON PRINTING (SPECIAL) CHARACTER
/
NPC,	TAD	(25)		/ IS THE CHARACTER A FORM FEED: (-41)+(25)=- (14)
	SNA
	JMP	LPTCTRL		/YES, NOW CHECK IF SPECIAL
	TAD	(-2)		/NO, WHAT ABOUT START OF RULER (16)
	SNA CLA
	JMP	SKPRULER	/YES, GO IGNORE RULER
	TAD	CHARIN		/NO, GET CHAR BACK
	AND	(7600)		/ LOOK AT MODE BITS
	SZA CLA
	JMP	RDNEXT		/YES, SO IGNORE IT
	TAD	CHARIN		/NO, GET CHAR ONCE MORE
	AND	P177		/ STRIP MODE BITS
	TAD	(-BELL)		/ TEST FOR ^G (MODIFIED FLAG) ?
	SNA CLA
	JMP	RDNEXT		/YES, JUST IGNORE
NORMFF,	TAD	CHARIN		/GET CHARACTER TO RETURN WITH
	AND	P177		/ STRIP MODE BITS
	JMS	OUT2VT		/SHOW CHAR ON SCREEN
	MQL			/SAVE CHAR
	TAD	RDFLAG		/ TEST 'IGNORE ALL' FLAG
	SNA CLA
	JMP	RDNEXT		/YES, IGNORE CHARACTER
	MQA			/NO, GET CHAR BACK
	ISZ	RD1CHR		/ +1 TO RETURN ADDRESS
	JMP I	RD1CHR		/ EXIT
/
/LOOKING FOR -1014 (START OF PRINTER CONTROL)
/ OR -1414 (END OF PRINTER CONTROL)
/
LPTCTRL,TAD	CHARIN		/TEST FOR 'START OF PRINTER CONTROL'
	TAD	(-1014)
	SZA CLA			/YES, IGNORE ALL CHAR UNTIL 'END OF PRINTER CONTROL'
	JMP	NORMFF		/NO, MUST HAVE BEEN NORMAL FF
TILEND,	JMS	RDNXCH		/GET A CHAR
	JMP I	RD1CHR		/ *** ERROR EXIT, DISK EOF ***
	TAD	(-1414)		/ 'END OF PRINTER CONTROL' YET ?
	SZA CLA
	JMP	TILEND		/ KEEP LOOKING FOR 'END OF PRINTER CONTROL'
	JMP	RDNEXT		/YES, BACK TO NORMAL PROCESSING
/
/START OF RULER (16) WAS FOUND ... IGNORE THE RULER
/
SKPRULER,JMS	RDNXCH		/GET A CHARACTER
	JMP I	RD1CHR		/ *** ERROR EXIT ***
	TAD	(-17)		/END OF RULER?
	SZA CLA
	JMP	SKPRULER		/NO, KEEP LOOKING
	JMP	RDNEXT		/YES, BACK TO NORMAL PROCESSING
	
RSDSK,	XX		/ DISPLAYS 'REPLACE SYSTEM DISKETTE, CALLED IF USER
	CIFMNU		/ TYPES GOLD M AND A DOCUMENT RATHER THAN SYSTEM
	JMS I	IOACAL	/ DISKETTE IS IN DRIVE 0
	  0
	  RSYS		/ REPLACE SYSTEM DISKETTE TEXT
	  2405
SDFW,	NARG		/ FIRST WORD EITHER OR OR " "
	JMP I 	RSDSK

	PAGE

/DISPLAY (OUTPUT TO THE SCREEN) THE CHARACTER IN THE AC AT ENTRY
/ (INSERTING A <CR><LF> WHEN THE CHAR IN THE AC AT ENTRY = <LF>
/
/This routine has been moved to page 1000 to make room for the dead key	/a031
/changes.								/a031

/d031	OUT2VT,	0
/d031	DCA	CHR2VT		/SAVE CHARACTER TO BE DISPLAYED
/d031	TAD	CHR2VT		/CHECK FOR <CR> RIGHT AWAY
/d031	TAD	(-CR)
/d031	SZA CLA
/d031	JMP	NOTCR
/d031	DCA	DEADKEY
/d031	JMP	VTEXIT
/d031	NOTCR,	TAD	DEADKEY		/SEE IF IN MIDDLE OF DEADKEY SEQUENCE
/d031	SZA CLA
/d031	JMP	VTEXIT		/YES, DON'T OUTPUT CHAR
/d031	TAD	CHR2VT
/d031	TAD	(-BACKSP)	/BACKSPACE ?
/d031	SZA
/d031	JMP	NOTBACKSPACE
/
/ START OF DEADKEY SEQUENCE
/
/d031	AC7777;	DCA DEADKEY	/SET DEADKEY FLAG
/d031	CIFMNU
/d031	JMS I IOACAL		/DISPLAY DEAD KEY SEQUENCE
/d031	0
/d031	ASTRING
/d031	ASDK
/d031	JMP	VTEXIT		/GET CHARACTER BACK AND EXIT
/d031	NOTBACKSPACE,TAD (BACKSP-LF)	/SEE IF LF
/d031	SZA CLA
/d031	JMP	NOTEOL		/NO		M007
/d031	JMS NEWLN		/OUTPUT CARRIAGE RETURN LINE FEED	 A007
/d031	VTEXIT,	TAD	CHR2VT		/GET CHAR BACK
/d031	JMP I	OUT2VT		/AND EXIT
/d031
/d031	NOTEOL,	CIFMNU			/ CHANGE THE 'IF' TO THE 'MENU' FIELD	A007
/d031	JMS I	IOACAL		/ TO 'IOA' FOR CHARACTER OUTPUT		A007
/d031	0
/d031	ASTRING			/ ^S MEANS AN ASCII STRING (OF 1 CHAR)	A007
/d031	CHR2VT			/ 'CHR2VT' CONTAINS 7-BIT ASCII 	A007
/d031	JMP	VTEXIT		/


/****************************************************************************
/
/	The following code was moved here to make room for changes to	/a031
/	the parsing code for dead key sequence evaluation.		/a031
/
/****************************************************************************

/ CHECK FOR WINCHESTER DRIVE						/A030

TOSCKW,	XX		/ CK FOR WINCHESTER ON SYSTEM			/A030
	CLA		/ CLEAR AC					/A030
	CDFMNU		/ MENU FIELD					/A030
	TAD MUBUF+MNOPTN	/ FECTH OPTION WORD			/A030
	CDFMYF		/ BACK TO THIS FIELD				/A030
	DCA	TSOPTN	/ SAVE VALUE					/A030
	AC0004		/ MASK - WINCHESTER INSTALLED			/A030
	AND	TSOPTN	/ IS WINNIE BIT SET ?				/A030
	SNA	CLA	/ YES - SKIP AND CONTINUE			/A030
	JMP	TSCTD1	/ NO - INSERT TEXT "DRIVE" ONLY			/A030
	TAD	CUSRC6	/ CK FOR DRIVE 0				/A030
	SNA		/ NO - SKIP & CONTINUE				/A030
	JMP	TSCTD2	/ YES - GO INSERT "DRIVE/DEVICE"		/A030
	TAD	(-1	/ CK FOR DRIVE 1				/A030
	SZA	CLA	/ YES - SKIP & CONTINUE				/A030
	JMP	TSCTW	/ NO - INSERT "VOLUME ON DEVICE			/A030
	AC0010		/ MASK - VOLUME ASSIGNED TO 1			/A030
	AND	TSOPTN	/ IS VOLUME ASSIGNED				/A030
	SNA	CLA	/ YES - SKIP & INSERT "VOLUME ON DEVICE		/A030
	JMP	TSCTD2	/ NO - GO INSERT "DISKETTE ON DRIVE		/A030

TSCTW,	TAD	(DERVL1)	/ ADDR OF "VOLUME ON DEVICE		/A030
	DCA	TSSTRA	/ INTO PARAMETER LIST				/A030
	TAD	(TSDEV)	/ ADDR OF "DRIVE/DEVICE				/A030
	DCA	NWSTR	/ INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE	/A030
	JMP	TSCKEX	/ BRANCH TO EXIT				/A030

TSCTD1,	TAD	(SRDRV)	/ ADDR OF "DRIVE				/A030
	DCA	NWSTR	/ INTO LIST - "SPECIFY ANOTHER DRIVE		/A030
	JMP	TSCTD3	/						/A030

TSCTD2,	TAD	(TSDEV)	/ ADDR OF "DRIVE/DEVICE				/A030
	DCA	NWSTR	/ INTO LIST - "SPECIFY ANOTHER DRIVE/DEVICE	/A030
TSCTD3,	TAD	(DERDS1)	/ ADDR OF "DISKETTE IN DRIVE		/A030
	DCA	TSSTRA	/ INTO LIST					/A030
TSCKEX,	JMP I	TOSCKW	/ RETURN					/A030
TSOPTN,	0000		/ OPTION WORD					/A030

/****************************************************************************
/
/			END  OF  MOVED  CODE				/M031
/
/****************************************************************************


CHARIN,	0
RDFLAG,	0

TOEFLG,	0

/d031	CHR2VT,	ZBLOCK	1			/ 7-BIT ASCII FOR OUTPUT TO THE SCREEN
/d031	0				/ [0] TERMINATOR FOR 'ASTRING'



/ 6-BIT TEXT STRING COMPARISON SUBROUTINE
/	JMS TXTCOM; MTEXT; ERROR RETURN; OK RETURN
/THE ORDER OF CHAR COMPARS FROM THE 'TEXT' STRING IS:  CX(1ST)  CY(2ND)
/
TXTCOM,	0
	AC7777
	TAD I	TXTCOM		/ADDR-1 BECAUSE OF 'ISZ' THEN 'TAD I'
	ISZ	TXTCOM		/ GET THE ADDRESS OF THE 'M'TEXT
	DCA	TXTADR		/SAVE THAT ADDRESS
TSC1,	AC7776			/ -2
	DCA	COUNT		/TWO 'TEXT' CHARACTERS PER 12-BIT WORD
	ISZ	TXTADR
/
/ NOTE THAT THE (AC) = 0 HERE NATURALLY
/
TSC2,
	TAD I	TXTADR		/GET TWO 'TEXT' CHARACTERS:  CX  CY
	ISZ	COUNT
	BSW			/AC LOOKS LIKE:  CY  CX
	AND	(37)		/KEEP ONE
	SNA
	JMP EXIT
	DCA	T1		/ AND TEMP (T1) SAVE IT
	JMS	RD1CHR		/READ 1 CHARACTER FROM THE SORT SPEC DOC
	JMP I TXTCOM			/ ** ERROR ** IF NO CHARACTERS REMAIN
	AND	(37)		/ MAKE  CHAR FROM SPEC DOC LOWER CASE
	CIA			/THEN NEGATE IT FOR A COMP LATER
	DCA THCHAR		/STORE THE NEGATED CHARACTER FROM SPEC DOC
	TAD THCHAR		/GET IT BACK IN AC
	TAD	T1		/GET BACK NEGATED CHAR VALUE FROM MTEXT
	SZA CLA			/ARE THEY EQUAL?
	JMP I TXTCOM		/NO ERROR RETURN
	TAD	COUNT		/YES CONTINUE COMPARE
	SNA CLA
	JMP	TSC1		/TO RESET THE 'COUNT'
	JMP	TSC2		/TO GET THE OTHER CHARACTER FROM THE TXTADR
EXIT,	ISZ TXTCOM		/INCREMENT FOR NON ERROR RETURN
	JMP I TXTCOM		/RETURN


/D026	IFDEF WS102 <
/
INPUT, CDFMYF			/MAKE SURE DATA FIELD IS SET TO MINE	A008
	CIFMNU			/CHANGE INSTRUCTION FIELD TO MINE	A008
	JMS I INACAL		/READ INPUT				A008
		INBUF		/BUFFER TO HOLD KEYBOARD INPUT		A008
		JMP GLDKY	/PROCESS GOLD KEY INPUT			A008
	JMS RBELL		/NOT GOLD KEY RING BELL			A008
	JMP INPUT		/READ INPUT AGAIN			A008

GLDKY,	JMS GMTST		/TEST AND HANDLE GOLD KEY		A008
	JMP CUSR1		/GOLD M SO EXIT				A008
	JMS RBELL		/GOLD GARBAGE RING BELL			A008
	JMS ORGOLD		/DISPLAY PRESS GOLD M			A008
		NARG		/DO NOT DISPLAY OR			A008
	JMP INPUT		/READ INPUT AGAIN			A008

RBELL,	XX
	CIFMNU
	JMS I IOACAL
	0
	ASTRING
	BELTXT
	JMP I RBELL

/D026		>	/ END IFDEF WS102

/d031	DEADKEY,0
TXTADR,	0
COUNT,	-2
THCHAR,	0000

THRHRD,	0300

/ CALLED WITH POSITION OF CURSOR IN AC

ERASE,	XX
	DCA	CRPOS	/ STORE POSITION FOR CURSOR
	CIFMNU
	JMS I	IOACAL
	  0
	  PSCR		/ STRING TO ERASE SCREEN AND POSITION CURSOR
CRPOS,	0000		/ CURSOR POSITION PASSED IN AC FROM CALLER
	JMP I	ERASE	/ RETURN

PRETURN,XX		/ DISPLAYS 'and press return
	CIFMNU
	JMS I	IOACAL
	  0
	  PRTRN
	  2305
	JMP I	PRETURN

PAGE




	PAGE

CUSRDN,	ZBLOCK STRLEN	/RESULT DOCUMENT NAME
CUSSDN,	ZBLOCK STRLEN	/SPEC DOCUMENT NAME
CUSLDN,	ZBLOCK STRLEN	/LIST DOCUMENT NAME
SRT,
  IFDEF ENGLSH 	< TEXT '^P--&S&O&R&T--' >
  IFDEF ITALIAN < TEXT /^P--!&ORDINAMENTO--/ >
  IFDEF V30NOR 	< TEXT '^P--!&SORTERING--'>
  IFDEF V30SWE 	< TEXT '^P--!&SORTERING--'>
  IFDEF DUTCH	< TEXT '^P-- &SORTEREN --'>
  IFDEF SPANISH < TEXT '^P-!&CLASIFICAR--'>


SPRMPT,	
  IFDEF ENGLSH 	< TEXT '^P&TYPE THE NAME OF THE ^P^S'  >
  IFDEF ITALIAN < TEXT /^P&INTRODURRE IL DOCUMENTO ^P^S/ >
  IFDEF V30NOR 	< TEXT '^P&SKRIV NAVNET P\E ^P^S'>
  IFDEF V30SWE 	< TEXT '^P&SKRIV NAMNET P\E ^P^S'>
  IFDEF DUTCH	< TEXT '^P&TYPE DE NAAM VAN ^P^S'>
  IFDEF SPANISH	< TEXT '^P&TECLEE EL NOMBRE DE ^P^S'>


GSPEC,
  IFDEF ENGLSH 	< TEXT 'SORT SPECIFICATION DOCUMENT.'  >
  IFDEF ITALIAN < TEXT /DI SPECIFICA ORDINAMENTO./  >
  IFDEF V30NOR 	< TEXT 'SORTERINGSPESIFIKASJONEN.'>
  IFDEF V30SWE 	< TEXT 'URVALSDOKUMENTET'>
  IFDEF DUTCH	< TEXT 'DE SORTEERSPECIFICATIE'>
  IFDEF SPANISH < TEXT 'DOC. DE CLASIFICACI\SN DE ESPECIFICACI\SN.'>


GLST,
  IFDEF ENGLSH 	< TEXT 'INPUT DOCUMENT YOU WANT TO SORT.' >
  IFDEF ITALIAN < TEXT /LISTA DA ORDINARE./ >
  IFDEF V30NOR < TEXT 'DET DOKUMENTET DU VIL SORTERE'>
  IFDEF V30SWE < TEXT 'REGISTERDOKUMENTET SOM DU VILL HA SORTERAT'>

GRES,
  IFDEF ENGLSH < TEXT 'OUTPUT DOCUMENT THAT WILL RECEIVE'
GRES2,	TEXT '^PTHE SORTED COPY OF THE INPUT DOCUMENT.'
 >
  IFDEF ITALIAN < TEXT 'DI USCITA.'>
  IFDEF V30NOR < TEXT 'DET DOKUMENTET DEN SORTERE'		/M008

GRES2,									/M008
	TEXT '^PKOPIEN SKAL LEGGES I.'			/M008
  >

  IFDEF V30SWE < TEXT 'SLUTDOKUMENTET SOM DU VILL HA SORTERAT'

GRES2,
 	TEXT 'DET SORTERADE REGISTERDOKUMENTET'
>

 	IFDEF DUTCH <
	TEXT 'HET DOCUMENT WAARIN HET RESULTAAT MOET KOMEN'
GRES2,	TEXT ''
	>

	IFDEF SPANISH <
	TEXT 'DOC. SALIDA QUE RECIBIR\A'
GRES2,	TEXT '^PLA COPIA CLASIFICADA DEL DOC. DE ENTRADA.'>


DEXTS,

  IFDEF ENGLSH < TEXT '^P&DOCUMENT ALREADY EXISTS. '
*.-1
	TEXT '^P&HOW WOULD YOU LIKE THE DOCUMENT MODIFIED?'
*.-1
	TEXT '^P&T = &ADD TEXT TO THE TOP '
*.-1
	TEXT '^P&B = &ADD TEXT TO THE BOTTOM'				/M021
*.-1	
	TEXT '^P&O = &OVERWRITE THE DOCUMENT'
*.-1	

	TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.'
  >

  IFDEF ITALIAN <  TEXT '^P&DOCUMENTO ESISTENTE. '
*.-1
	TEXT '^P&MODALIT\@ DI MODIFICA: '
*.-1
	TEXT /^P&I = &INSERIMENTO TESTO ALL'INIZIO /
*.-1
	TEXT '^P&F = &INSERIMENTO TESTO ALLA FINE '				/M021
*.-1	
	TEXT '^P&S = &SOVRASCRITTURA '
*.-1	

	TEXT /^P&SCEGLIERE UN'OPZIONE E &PREMERE !&RITORNO./
  >
  IFDEF V30NOR < TEXT '^P&DOKUMENTET FINNES ALLEREDE.'
*.-1
	TEXT '^P&HVORDAN VIL DU ENDRE DOKUMENTET? '
*.-1
	TEXT '^P&T = &TILF\XYE TEKST P\E TOPPEN '
*.-1
	TEXT '^P&B = &TILF\XYE TEKST P\E BUNNEN '			/M021
*.-1	
	TEXT '^P&O = &OVERSKRIVE DOCUMENTET'
*.-1	

	TEXT '^P&TYPE THE LETTER AND &PRESS &R&E&T&U&R&N.'
  >

  IFDEF V30SWE < TEXT '^P&DOKUMENTET FINNS REDAN '
*.-1
	TEXT '^P&HUR VILL DU \DNDRA I DOKUMENTET? '
*.-1
	TEXT '^P%B = &L\DGGA TILL TEXT I B\VRJAN '
*.-1
	TEXT '^P%S = &L\DGGA TILL TEXT I SLUTET'		/M021
*.-1	
	TEXT '^P%S%K = &SKRIVA \VVER DOKUMENTET'
*.-1	

	TEXT '^P&TYPE THE LETTER AND &PRESS !&RETURN.'
  >

  IFDEF DUTCH < TEXT '^P&DOCUMENT BESTAAT AL. '
*.-1
	TEXT '^P&HOE WILT U DIT DOCUMENT WIJZIGEN?'
*.-1
	TEXT '^P&B = &VOEG TEKST TOE AAN HET BEGIN'
*.-1
	TEXT '^P&E = &VOEG TEKST TOE ANN HET EINDE'			/M021
*.-1	
	TEXT '^P&O = &OVERSCHRIJF HET DOCUMENT'
*.-1	

	TEXT '^P&MAAK EEN KEUZE EN DRUK OP !&RETURN.'
  >


  IFDEF SPANISH < TEXT '^P&EL DOCUMENTO Y EXISTE. '
*.-1
	TEXT '^P\?&C\SMO LE GUSTAR\MA MODIFICAR EL DOCUMENTO? '
*.-1
	TEXT '^P&T = &A\QADIR TEXTO EN PARTE SUPERIOR '
*.-1
	TEXT '^P&B = &A\QADIR TEXTO EN PARTE INFERIOR '			/M021
*.-1	
	TEXT '^P&O = &ESCRIBIR SOBRE EL DOCUMENTO'
*.-1	

	TEXT '^P&TECLEE LA LETRA Y PULSE !&RETORNO.'
  >


NDOC,
  IFDEF ENGLSH < TEXT '^P&^S ^D DOES NOT HAVE A DOCUMENT NAMED ^A.'	/M030
  >
  IFDEF ITALIAN < TEXT /^P&^S ^D NON HA IL DOCUMENTO ^A./
  >
  IFDEF V30NOR < TEXT '^P&^S ^D HAR IKKE NOE DOKUMENT KALT ^A.'	/M030
  >
  IFDEF V30SWE < TEXT '^P&^S ^D HAR INGET DOKUMENT SOM HETER ^A'>
  IFDEF DUTCH  < TEXT '^P&^S ^D BEVAT GEEN DOCUMENT GENAAMD ^A.'>
  IFDEF SPANISH <TEXT '^P&^S ^D NO TIENE UN DOCUMENTO LLMADO ^A.'>



TRYAGN,									/m023
	IFDEF ENGLSH < / --------------------------------------------	/m023
 TEXT '^P&WHEN TYPING TO THE MENU, USE THE NORMAL KEYS ON THE KEYBOARD ONLY.  '
	*.-1
IFDEF CONDOR <								/A024
  TEXT '^P&THE &RUBOUT KEY'						/M024
> / END IFDEF CONDOR							/A024
IFNDEF CONDOR <								/A024
  TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D'				/A024
> / END IFNDEF CONDOR							/A024
	*.-1
  TEXT ' CAN ALSO BE USED.  &A LINE MAY CONTAIN A MAXIMUM  '		/M024
	*.-1	
  TEXT '^POF 71 CHARACTERS AND MUST END WITH &R&E&T&U&R&N.  '
	*.-1
  TEXT '^P&PLEASE PRESS &R&E&T&U&R&N AND TRY AGAIN.'
  >									/Amdh
/ end ifdef ENGLSH --------------------------------------------------

  IFDEF ITALIAN <
TEXT'^P&PER SCEGLIERE LE OPZIONI DEL MENU UTILIZZARE SOLO I TASTI ALFANUMERICI '
	*.-1
IFDEF CONDOR <								/A024
  TEXT '^P&E SE NECESSARIO IL TASTO'						/M024
> / END IFDEF CONDOR							/A024
IFNDEF CONDOR <								/A024
  TEXT '^P&R&U&B &C&H&A&R AND &R&U&B &W&O&R&D'				/A024
> / END IFNDEF CONDOR							/A024
	*.-1
  TEXT ' !A&X]. &UNA RIGA PU\R CONTENERE AL'		/M024		/Mmdh
	*.-1	
  TEXT '^PMASSIMO 71 CARATTERI E DEVE TERMINARE CON !&RITORNO.  '
	*.-1
  TEXT '^P&PREMERE !&RITORNO PER CONTINUARE.'
	74;0								/amdh
  >

	IFDEF V30NOR < / --------------------------------------------	/m023
 TEXT '^P&BRUK BARE TASTENE P\E HOVEDTASTATURET N\ER DU SKRIVER EN KOMMANDO. '
	*.-1
IFDEF CONDOR <								/A024
  TEXT '^P!&SLETT-TASTEN'						/M024
> / END IFDEF CONDOR							/A024
	*.-1
  TEXT ' KAN OGS\E BRUKES. &EN LINJE KAN HA MAKS. '		/M024
	*.-1	
  TEXT '^P71 TEGN OG M\E AVSLUTTES MED !&RETUR. '
	*.-1
  TEXT '^P&TRYKK P\E !&RETUR OG PR\XV IGJEN.'
  >									/Amdh

	IFDEF V30SWE <
  TEXT '^P&ANV\DND BARA "VANLIGA" TANGENTER N\DR DU SKRIVER I MENYN '
	*.-1
	TEXT '^P!&BACKSTEG'
        *.-1
  TEXT ' KAN OCKS\E ANV\DNDAS. &EN  RAD F\ER BEST\E AV MAXIMALT'
        *.-1
  TEXT '^P71 TCKEN OCH M\ESTE AVSLUTAS MED !&RETUR'
	*.-1
  TEXT '^P&TRYCK P\E !&RETUR OCH F\VRS\VK IGEN'
>
 IFDEF DUTCH <
  TEXT '^P&GEBRUIK ALLEEN DE TOETSEN OP HET HOOFDTOETSENBORD. '
  *.-1
  TEXT '^P&U KUNT DE TOETS  X&] GEBRUIKEN OM TEKENS TE WISSEN.'
  *.-1
  TEXT 'EEN REGEL MAG 71 TEKENS BEVATTEN GEVOLGD DOOR !&RETURN. '
  *.-1
  TEXT '^P'
  *.-1
  TEXT '^P&DRUK OP !&RETURN PROBEER OPNIEUW.'
>
 IFDEF SPANISH <
  TEXT '^P&CUANDO TECLEE EN EL MEN\Z, USE S\SLO LAS TECLAS DEL TECLADO NORMAL.'
  *.-1
  TEXT '^P&LA TECLA &CORRECTORA TAMBI\IN SE PUEDE USAR. &UNA L\MNEA PUEDE '
  *.-1
  TEXT 'CONTENER UN M\AXIMO DE ^P71 CARACTERES Y HA DE TERMINAR CON !&RETORNO'
>
  
SRLCKER,	
  IFDEF ENGLSH 	< TEXT '^P^A&DOCUMENT (!D.!D)^A IS ALREADY IN USE.'  >
  IFDEF ITALIAN < TEXT /^P^A&DOCUMENTO (!D.!D)^A GI\@ IN USO./  >
  IFDEF V30NOR 	< TEXT '^P^A&DOKUMENT (!D.!D)^A FINNES ALLEREDE.'  >
  IFDEF V30SWE 	< TEXT '^P^A&DOKUMENT (!D.!D)^A ANV\DNDS REDAN'>
  IFDEF DUTCH	< TEXT '^P^A&DOCUMENT (!D.!D)^A IS AL IN GEBRUIK.' >
  IFDEF SPANISH < TEXT '^P^A&EL DOCUMENTO (!D.!D)^A YA EST\A EN USO.'>

TARTN,
  IFDEF ENGLSH 	< TEXT '^P&PRESS &R&E&T&U&R&N TO TRY ANOTHER NAME.'  >
  IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO, USARE UN ALTRO NOME.'>
  IFDEF V30NOR 	< TEXT '^PTRYKK P\E !&RETUR OG ANGI ET ANNET NAVN.'>
  IFDEF V30SWE 	< TEXT '^PTRYCK P\E !&RETUR OCH SKRIV ETT ANNAT NAMN' >
  IFDEF DUTCH 	< TEXT '^P&DRUK OP !&RETURN EN PROBEER OPNIEUW'>
  IFDEF SPANISH < TEXT '^P&PULSE !&RETORNO PARA INTENTAR OTRO NOMBRE.'>




CNTCRE,	
  IFDEF ENGLSH 	< TEXT '^P&UNABLE TO CREATE DOCUMENT.'  >
  IFDEF ITALIAN < TEXT '^P&IMPOSSIBILE CREARE DOCUMENTO.' >
  IFDEF V30NOR 	< TEXT '^PKAN IKKE OPPRETTE DOKUMENT.' >
  IFDEF V30SWE 	< TEXT '^PDET G\ER INTE ATT SKAPA DOKUMENT.'>
  IFDEF DUTCH	< TEXT '^P&KAN DOCUMENT NIET AANMAKEN.'>
  IFDEF SPANISH < TEXT '^P&IMPOSIBLE CREAR EL DOCUMENTO.'>



WNUM,	
  IFDEF ENGLSH  < TEXT '^P&DOCUMENT NUMBERS MUST BE FROM 1 TO 200.'  >
  IFDEF ITALIAN < TEXT '^P&NUMERI DOCUMENTO DEVONO ESSERE DA 1 A 200.' >
  IFDEF V30NOR 	< TEXT '^PDOKUMENTNUMRENE G\ER FRA 1 TIL 200.'>
  IFDEF V30SWE 	< TEXT '^PDOKUMENTETS NUMMER M\ESTE VARA 1-200.' >
  IFDEF DUTCH   < TEXT '^PDOCUMENTNUMMERS MOETEN LIGGEN TUSSEN 1 EN 200.'>
  IFDEF SPANISH < TEXT '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'>


NMDC,	
  IFDEF ENGLSH 	< TEXT  '^P&THERE ARE NO MORE DOCUMENTS AVAILABLE.'  >
  IFDEF ITALIAN < TEXT '^P&NON CI SONO DOCUMENTI DISPONIBILI.'  >
  IFDEF V30NOR 	< TEXT  '^P&INGEN LEDIGE DOKUMENTER.'  >
  IFDEF V30SWE 	< TEXT  '^P&DET FINNS INGA FLER DOKUMENT.'  >
  IFDEF DUTCH 	< TEXT  '^P&MAXIMALE AANTAL DOCUMENTEN BEREIKT.'>
  IFDEF SPANISH	< TEXT  '^PNO HA M\AS DOCUMENTOS DISPONIBLES.'>


CNRG,	
	TEXT '^P '

TYPGO,
  IFDEF ENGLSH < TEXT '^P&TYPE !&GO TO BEGIN &SORT'			/M021
  >
  IFDEF ITALIAN < TEXT '^P&INTRODURRE &E PER INIZIARE &ORDINAMENTO'	/M021
  >
  IFDEF V30NOR < TEXT '^P&SKRIV !&ST FOR \E SORTERE DOKUMENTET.'			/M021
  >
  IFDEF V30SWE < TEXT '^P&SKRIV !&OK F\VR ATT B\VRJA SORTERA.'			/M021
  >
  IFDEF DUTCH < TEXT '^P&TYP !&SV OM MET SORTEREN.'>
  IFDEF SPANISH < TEXT '^P&TECLEE &G&O PARA COMENZAR A &CLASIFICAR'>



NMEAN,									/m0018
  IFDEF ENGLSH <
  TEXT '^P &TYPING "^A" HAS NO MEANING HERE. &PRESS &R&E&T&U&R&N AND TRY AGAIN.' /M011
  >
  IFDEF ITALIAN <
  TEXT '^P &OPZIONE NON VALIDA.' /M011
  >
  IFDEF V30NOR <
  TEXT '^P "^A" KAN IKKE BRUKES HER. &TRYKK P\E !&RETUR OG PR\XV IGJEN.' /M011
  >
  IFDEF V30SWE <
  TEXT '^P "^A" BETYDER INGENTING H\DR.&TRYCK P\E !&RETUR OCH F\VRS\VK IGJEN.' /M011
  >
  IFDEF DUTCH <
  TEXT '^P &"^A" HEEFT HIER GEEN BETEKENIS. &DRUK OP !&RETURN.'>
  IFDEF SPANISH <
  TEXT '^P &"^A" IS INCORRECTO. &PULSE !&RETORNO E INT\INTELO OTRA VEZ.'>



PRTRN,
  IFDEF ENGLSH < TEXT '^P&AND &PRESS &R&E&T&U&R&N.'			
  >/M008
  IFDEF ITALIAN < TEXT '^P&PREMERE !&RITORNO.'			
  >/M008
  IFDEF V30NOR < TEXT '^POG TRYKK P\E !&RETUR.'			
  >/M008
  IFDEF V30SWE < TEXT '^POCH TRYCK P\E !&RETUR.'			
  >/M008
  IFDEF DUTCH < TEXT '^P&DRUK OP !&RETURN.'>
  IFDEF SPANISH < TEXT '^P&Y PULSE !&RETORNO.'>



DOGM,
  IFDEF ENGLSH < TEXT '^P^A&PRESS &GOLD &M&E&N&U TO RECALL THE &MAIN &MENU.'
  >/M008
  IFDEF ITALIAN < 
  TEXT '^P^A&PREMERE &ORO !&MENU PER TORNARE AL &MENU &PRINCIPALE.'
  >/M008
  IFDEF V30NOR < TEXT '^P^A&TRYKK P\E &GULL !&MENY FOR \E F\E &HOVEDMENYEN.'
  >/M008
  IFDEF V30SWE < TEXT '^P^A&TILLBAKA TILL HUVUDMENYN: AND\DND !&GULD !&MENY.'
  >/M008
  IFDEF DUTCH <
 TEXT '^P^A&DRUK OP &GOUD !&MENU OM TERUG TE GAAN NAAR HET &HOOFDMENU.'>
  IFDEF SPANISH <
 TEXT '^P^A&PULSE &DORADA !&MENU PARA VOLVER AL &MEN\Z &PRINCIPAL.'>


ORAR,	
  IFDEF ENGLSH < "O-200;"R-200;40;0
  >
  IFDEF ITALIAN < 0
  >
  IFDEF V30NOR < "E-200; "L-200; ".-200;40;0>
  IFDEF V30SWE < "E-200; "L-200; ".-100;40;0>

NARG,
	IFNDEF DUTCH <
	0
	>
	IFDEF DUTCH <
	40;0
	>
AARG,
  IFDEF ENGLSH < "A-200;"N-200;"D-200;40;0
  >
  IFDEF ITALIAN < "E-200;40;0
  >
  IFDEF V30NOR < "O-200;"G-200;40;0>

  IFDEF V30SWE < "O-200;"C-200;"H-200;40;0>

  IFDEF DUTCH <40;0>

  IFDEF SPANISH < "Y-200;40;0>

RSYS,
  IFDEF ENGLSH < TEXT '^P^A&REPLACE THE SYSTEM DISKETTE IN DRIVE 0'
  >
  IFDEF ITALIAN < TEXT /^P^A&INSERIRE IL DISCO SISTEMA NELL'UNIT\@ 0/
  >
  IFDEF V30NOR < TEXT '^P^A&SETT SYSTEMDISKETTEN TILBAKE I STASJON 0'
  >
  IFDEF V30SWE < TEXT '^P^A&S\DTT TILLBAKA SYSTEMDISKETTEN I ENHET 0'
  >
  IFDEF DUTCH < TEXT '^P^AZET DE SYSTEEMDISKETTE IN AANDRIJVER 0'>
  IFDEF SPANISH < TEXT '^P^AREPLACE THE DISKETTE IN UNIDAD 0'>


CUSR1A,
  IFDEF ENGLSH < TEXT '^P&INPUT DOCUMENT: (^D.^D) ^A '			/M008

*.-1
	TEXT '^P&USING SORT SPECIFICATION DOCUMENT: (^D.^D) ^A'
*.-1	/THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL
	TEXT '^P&THE SORTED DOCUMENT WILL BE STORED IN: (^D.^D) ^A'
*.-1
	TEXT '^P&!D &KEY &SORT'
	>

  IFDEF ITALIAN < TEXT '^P&DOCUMENTO LISTA: (^D.^D) ^A '		/M008

*.-1
	TEXT '^P&DOCUMENTO DI SPECIFICA ORDINAMENTO: (^D.^D) ^A '
*.-1	/THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL
	TEXT '^P&DOCUMENTO USCITA: (^D.^D) ^A '
*.-1
	TEXT '^P&!D &CHIAVI &ORDINAMENTO'
	>

  IFDEF V30NOR < TEXT '^P&DOKUMENT SOM SKAL SORTERES: (^D.^D) ^A '	/M008

*.-1
	TEXT '^P&BRUKER SORTERINGSSPESIFIKASJON: (^D.^D) ^A '
*.-1	/THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL
	TEXT '^P&SORTERT KOPI LAGRES I: (^D.^D) ^A'
*.-1
	TEXT '^P&!D SORTERINGSN\XKLER'
	>

  IFDEF V30SWE < TEXT '^P&DU ANV\DNDER REGISTERDOKUMENT (^D.^D) ^A '	/M008

*.-1
	TEXT '^P&URVALSDOKUMENTET \DR (^D.^D) ^A'
*.-1
	TEXT '^P&DET SORTERADE REG (SLUTDOKUMENTET) \DR: (^D.^D) ^A '
*.-1	/THIS CLOBBERS ZERO WORD SO IOA WILL PROCESS MORE THAN 1 LINE PER CALL
	TEXT '^P&!D SORTERINGSNYCKEL'
	>
  IFDEF DUTCH < TEXT '^P&HET TE SORTEREN BESTAND IS: (^D.^D) ^A '			/M008

*.-1
	TEXT '^P&DE SORTEERSPECIFICTIE IS: (^D.^D) ^A'
*.-1	
	TEXT '^P&HET RESULTAT KOMT IN DOCUMENT: (^D.^D) ^A'
*.-1
	TEXT '^P&ER WORDT GESORTEERD OP !D VELD(EN).'
	>

  IFDEF SPANISH < 
	TEXT '^P&DOCUMENTO DE ENTRADA: (^D.^D) ^A '
*.-1
	TEXT '^P&USANDO DOCUMENTO ESPECIFICACI\SN CLASIFICACI\SN:^A '	/M008
*.-1
	TEXT '^P&EL DOC. CLASIFICADO SE ALMACENAR\A EN: (^D.^D) ^A'
*.-1
	TEXT '^P&!D &CLAVE &CLASIFICACI\SN' >


TSMALL,
	IFDEF ENGLSH <
	TEXT '^P!E&THERE IS NOT ENOUGH ROOM ON THE ^S !D '		/A030
*.-1
	TEXT '^PFOR THE SORTED DOCUMENT.'
	  >/M008
	  IFDEF ITALIAN <
	TEXT /^P!E&SPAZIO INSUFFICIENTE SULL'^S !D /		/A030
	*.-1
	TEXT '^P'
	  >/M008
	IFDEF V30NOR <
	TEXT '^P!E&IKKE NOK PLASS P\E ^S !D '		/A030
*.-1
	TEXT '^PTIL DET SORTERE DOKUMENTET.'
        >/M008

	IFDEF V30SWE <
	TEXT '^P!E&DET FINNS INTE TILLR\CKLIGT MED  ^S !D '		/A030
*.-1
	TEXT '^PF\VR DET SORTERADE DOKUMENTET.'
        >/M008

	IFDEF DUTCH <
	TEXT '^P!E&ONVLDOENDE RUIMTE OP ^S !D VOOR HET RESULTAAT. ^P'
	>
	IFDEF SPANISH <
	TEXT '^P!E&NO HAY SUFICIENTE ESPACIO EN EL ^S !D'
*.-1
	TEXT '^PPARA EL DOCUMENTO CLASIFICADO.'
	>





NWDRV,
  IFDEF ENGLSH < TEXT '^P&SPECIFY ANOTHER ^S.'			/M030/M021
  >
  IFDEF ITALIAN < TEXT /^P&SPECIFICARE UN'ALTRA ^S./			/M030/M021
  >
  IFDEF V30NOR < TEXT '^P&ANGI EN ANNEN ^S.'>
  IFDEF V30SWE < TEXT '^P&V\DLJ ANNAN ^S.'>
  IFDEF DUTCH < TEXT '^P&GEBRUIK EEN ^S MET MEER RUIMTE.'>
  IFDEF SPANISH < TEXT '^P&ESPECIFIQUE OTRO ^S.'>


PTRBUS,
  IFDEF ENGLISH < TEXT '^P&THERE ARE DOCUMENTS PRINTING  >
  IFDEF ITALIAN < TEXT '^P&CI SONO DOCUMENTI IN STAMPA.'  >
  IFDEF V30NOR < TEXT '^P&UTSKRIVING AV DOKUMENTER P\EG\ER.'  >
  IFDEF V30SWE < TEXT '^P&UTSKRIFT P\EG\ER JUST NU.'  >
  IFDEF DUTCH < TEXT '^P&DE PRINTER IS IN GEBRUIK.'>
  IFDEF SPANISH <TEXT '^P&SE EST\AN IMPRIMIENDO DOCUMENTOS.'>	


DERR,
  IFDEF ENGLSH <
	TEXT '^P&THE ^S !D IS NOT A VALID DOCUMENT ^S.'			/M030
*.-1
	TEXT '^P&USE ANOTHER DOCUMENT ^S.'				/M030
  >
  IFDEF ITALIAN <
	TEXT /^P&^S !D NON \H UN VALIDO ^S. /			/M030
*.-1
	TEXT '^P&USARE UN ALTRO ^S.'				/M030
  >
  IFDEF V30NOR <
	TEXT '^P&^S !D ER IKKE EN GYLDIG DOKUMENT^S.'			/M030
*.-1
	TEXT '^P&BRUK EN ANNAN DOKUMENT^S.'				/M030
  >
  IFDEF V30SWE <
	TEXT '^P&^S !D \DR INTE ETT DOKUMENT SOM G\ER ATT ANV\DNDA^S.'	/M030
*.-1
	TEXT '^P&ANV\DND ETT ANNAT DOKUMENT ^S.'				/M030
  >
  IFDEF DUTCH <
	TEXT '^P&DE ^S !D IS GEEN DOCUMENT ^S.'			/M030
*.-1
	TEXT '^P&GEBRUIK EEN DOCUMENT ^S.'				/M030
  >
  IFDEF SPANISH <
	TEXT '^P&^P&EL ^S !D NO ES UN DOCUMENTO V\ALIDO ^S. '		/M030
*.-1
	TEXT '^P&USE OTRO DOCUMENTO ^S.'				/M030
  >



RPLACE,
  IFDEF ENGLSH <
	TEXT '^P&REPLACE THE DISKETTE WITH AN EMPTY DOCUMENT DISKETTE '
*.-1
	TEXT '^POR ONE WITH MORE AVAILABLE SPACE.'
  >									/M008
  IFDEF ITALIAN <
	TEXT '^P&UTILIZZARE UN ALTRO DISCHETTO.^P'
  >									/M008
  IFDEF V30NOR <
	TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET'
*.-1
	TEXT '^PSORTERTE DOKUMENTET.'
  >									/M008
  IFDEF V30SWE <
	TEXT '^P&ERSTATT DEN MED EN DISKETTEN SOM HAR PLASS TIL DET'
*.-1
	TEXT '^PSORTERTE DOKUMENTET.'
  >									/M008
 IFDEF DUTCH <
  TEXT '^P&VERVANG DE DISKETTE DOOR EEN LEGE DOCUMENTDISKETTE '
*.-1
  TEXT '^P OF EEN MET MEER RUIMTE.'
  >
 IFDEF SPANISH <
  TEXT '^P&RETIRE EL DISKETTE DOCUMENTO Y C\AMIELO POR UN DISKETTE HAY  '
*.-1
  TEXT '^P M\AS ESPACIO'>



RMOVE0,

  IFDEF ENGLSH < TEXT '^P&REMOVE THE DISKETTE IN DRIVE 0.'
*.-1
TEXT'^P&REPLACE IT WITH A DOCUMENT DISKETTE TO ACCOMMODATE THE SORTED DOCUMENT.'
  >
  IFDEF ITALIAN < TEXT /^P&TOGLIERE IL DISCHETTO DALL'UNIT\@ 0 /
*.-1
TEXT'^PE SOSTITUIRLO CON UN ALTRO.'
  >
  IFDEF V30NOR < TEXT '^P&FJERN DISKETTEN I STASJON 0 .'
*.-1
TEXT '^P&ERSTATT DEN MED EN DOKUMENTDISKETT SOM HAR PLASS TIL DET SORTERTE'
*.-1
TEXT ' DOKUMENTET'
  >

 IFDEF V30SWE < TEXT '^PTA UT DISKETTEN I ENHET 0 . '
*.-1
TEXT '^P&ERSTATT DEN MED DOK.DISKETT SOM KAN TA EMOT DET SORTERADE DOKUMENTET'
>

  IFDEF DUTCH < TEXT '^P&VERVANG DE DISKETTE IN AANDRIJVER 0.'
*.-1
TEXT'^PDOOR DE DISKETTE WAAROP HET RESULTAAT MOET KOMEN.'
  >
  IFDEF SPANISH < TEXT '^P&RETIRE EL DISKETTE DEL LA UNIDAD 0.'
*.-1
TEXT '^PC\AMIELO POR UN DISKETTE DOC. PARA ACOMODAR EL DOC. CALSIFICADO'>


/ NOTE THAT A <SPACE> DOES NOT EXIST BETWEEN THE WORDS 'SORT' AND 'ON'
/ BECAUSE THE SUBROUTINE ( 'RD1CHR' ) WHICH GETS A CHARACTER
/ FROM THE SPECIFICATION DOCUMENT IGNORES <SPACES> IF ENTERED WITH THE AC=0
/
/ THEREFORE THE SUBROUTINE 'TXTCOM' WHICH COMPARES TWO CHARACTERS
/ ( ONE OF WHICH IS A CHARACTER FROM THE SPEC DOC) - IGNORES <SPACES>
/
IFDEF ENGLSH <
MSORTON,	TEXT 'SORTON'		/ USED BY 'TXTCOM'
MINA,		TEXT 'INA'	/USED BY TXTCOM
ME,		TEXT 'E'	/USED BY TXTCOM
MSCENDING,	TEXT 'SCENDING'	/USED BY TXTCOM
MORDER,		TEXT 'ORDER'	/USED BY TXTCOM
MAND,		TEXT 'AND'	/USED BY TXTCOM				/A007
>
IFDEF ITALIAN <
MSORTON,	TEXT 'ORDINAMENTODI'		/ USED BY 'TXTCOM'
MINA,		TEXT 'INORDINEC'	/USED BY TXTCOM
ME,		TEXT 'EC'	/USED BY TXTCOM
MSCENDING,	TEXT 'RESCENTE'	/USED BY TXTCOM
MORDER,		TEXT ''	/USED BY TXTCOM
MAND,		TEXT 'E'	/USED BY TXTCOM				/A007
>
IFDEF V30NOR <
MSORTON,	TEXT 'SORTERETTER'
MINA,		TEXT 'ISTIG'
ME,		TEXT 'NK'
MSCENDING,	TEXT 'ENDE'
MORDER,		TEXT 'REKKEFOLGE'
MAND,		TEXT 'OG'
>


IFDEF V30SWE <
MSORTON,	TEXT 'SORTERAEFTER'
MINA,		TEXT 'ISTIG'
ME,		TEXT 'ALL'
MSCENDING,	TEXT 'ANDE'
MORDER,		TEXT 'ORDNING'
MAND,		TEXT 'OCH'
>

IFDEF DUTCH <
MSORTON,	TEXT 'SORTEEROP'
MINA,		TEXT 'INOP'
ME,		TEXT 'F'
MSCENDING,	TEXT 'LOPENDE'
MORDER,		TEXT 'VOLGORDE'
MAND,		TEXT 'EN'
>
IFDEF SPANISH <
MSORTON,	TEXT 'CLASIFICARSEGUN'
MINA,		TEXT 'ENORDENA'
ME,		TEXT 'E'
MSCENDING,	TEXT 'SCENDENTE'
MORDER,		TEXT ''
MAND,		TEXT ','
>



HC,				/POSITION CURSOR
	TEXT '^P'							/M008
PSCR,
	TEXT '^P!E'
ASTRING,				/POSITION THE CARET
	TEXT '^A'
ACARET,
	LF;BACKSP;"^-200;CR;LF;0
ASDK,
	ESC;"(;"0&177		/TURN ON GRAPHICS MODE
	ESC;"0;"G-140		/DISPLAY DEAD KEY SEQUENCE
	ESC;"(;"B&177		/TURN OFF GRAPHICS MODE AGAIN
	0
	
CRLF,	
	CR;LF;0
MWHAT,	
  IFDEF ENGLSH <

	TEXT '&E&R&R&O&R--SPECIFICATION NOT UNDERSTOOD STARTING AT THIS POINT.'
  >
  IFDEF ITALIAN <

	TEXT '!&ERRORE--SPECIFICA NON CORRETA DA QUESTO PUNTO.'
  >
  IFDEF V30NOR <
	TEXT '!&FEIL--FORST\ER IKKE SPESIFAKASJONEN FRA DETTE PUNKTET." >
  IFDEF V30SWE <
	TEXT '!&FEL - URVALSDOKUMENTET KAN INTE INLEDAS P\E DETTA S\DTT'>
  IFDEF DUTCH <
	TEXT '!&FOUT: &SPECIFICATIE NIET BEGREPEN VANAF DIT PUNT'>
  IFDEF SPANISH <
TEXT '!&ERROR--NO SE HA ENTENDIDO LA ESPECIFICACI\SN COMENZANDO EN ESTE PUNTO.'>

 

IFDEF ENGLSH <
FSERR, TEXT '^D FIELD NAMES HAVE BEEN SPECIFIED. &TEXT FOLLOWING THE'	/M021
FSER2, TEXT 'LAST COMPLETE KEY FIELD SPECIFICATION WILL BE IGNORED.'	/M021
PRCON, TEXT '&PRESS &R&E&T&U&R&N TO CONTINUE.'				/A007
>

IFDEF ITALIAN <
FSERR, TEXT '^D CAMPI NOME SPECIFICATI. &IL TESTO CHE SEGUE'	/M021
FSER2, TEXT /L'ULTIMO CAMPO SPECIFICATO VIENE IGNORATO./	/M021
PRCON, TEXT '&PREMERE !&RITORNO PER CONTINUARE.'				/A007
>

IFDEF V30NOR <
FSERR, TEXT '^D FELTNAVN ER SPESIFISERT. &DET VIL IKKE BLI TATT HENSYN'	/M021
FSER2, TEXT 'TIL TEKST SOM ST\ER ETTER SISTE FULLSTENDIGE FELTSPESIFIKASJON.'/M021
PRCON, TEXT '&TRYKK P\E !&RETUR FOR \E FORTSETTE.'			/A007
>

IFDEF V30SWE <
FSERR,	TEXT '^D F\DLTNAMN HAR SPECIFICERATS.&TEXT SOM FINNS EFTER DEN'
FSER2,	TEXT 'SISTA FULLST\DNDIGA SORTERINGNYCKELN KOMMER INTE ATT BEHANDLAS.'
PRCON,	TEXT '&TRYCK P\E !&RETUR F\VR ATT FORTS\DTTA.'>

IFDEF DUTCH <
FSERR,	TEXT '&E ZIJN ^D VELDNAMEN OPGEGEVEN. &TEKST NA DE LAATSTE'
FSER2,	TEXT 'VELDNAAMSPECIFICATIE ZAL WORDEN GENEGEERD.'
PRCON,	TEXT '&DRUK OP !&RERTURN OM VERDER TE GAAN.'>

IFDEF SPANISH <
FSERR,	TEXT '&SE HAN ESPECIFICADO NOMBRESS DE CAMPO^D. &TEXTO QUE SIGUE HA'
FSER2,
TEXT '&SE IGNORAR\A LA \ZLTIMA ESPECIFICACI\SN DE CAMPO DE CLAVE CPMPLETA.'
PRCON,	TEXT '&PULSE !&RETORNO PARA CONTINUAR'
>


BELTXT,
	BELL;0
GOTXT,	
  IFDEF ENGLSH < TEXT 'GO'
  >
  IFDEF ITALIAN < TEXT 'E'
  >
  IFDEF V30NOR < TEXT 'ST' >
  IFDEF V30SWE < TEXT 'OK' >
  IFDEF DUTCH < TEXT 'SV'>
  IFDEF SPANISH < TEXT 'GO'>


SRDRV,									/A030
  IFDEF ENGLSH < TEXT 'DRIVE'>						/A030
  IFDEF ITALIAN < TEXT 'UNIT\@'>						/A030
  IFDEF V30NOR < TEXT 'STASJON'>
  IFDEF V30SWE < TEXT 'ENHET'>
  IFDEF DUTCH < TEXT 'AANDRIJVER'>
  IFDEF SPANISH < TEXT 'UNIDAD'>


SRDEV,									/A030
  IFDEF ENGLSH < TEXT 'DEVICE'>						/A030
  IFDEF ITALIAN < TEXT 'UNIT\@'>						/A030
  IFDEF V30NOR < TEXT 'ENHET'>
  IFDEF V30SWE < TEXT 'ENHET'>
  IFDEF DUTCH  < TEXT 'AANDRIVJVER'>
  IFDEF SPANISH < TEXT 'DISPOSITIVO'>


DERDS1,									/A030
  IFDEF ENGLSH  < TEXT 'DISKETTE IN DRIVE'>				/A030
  IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/
	>				/A030
  IFDEF V30NOR < TEXT 'DISKETTEN I STASJON'>
  IFDEF V30SWE < TEXT 'DISKETTEN I ENHET'>
  IFDEF DUTCH  < TEXT 'DISKETTE IN AANDRIJVER'>
  IFDEF SPANISH< TEXT 'DISKETTE EN UNIDAD'>


DERDS2,									/A030
  IFDEF ENGLSH < TEXT 'DISKETTE'>					/A030
  IFDEF ITALIAN < TEXT 'SUPPORTO'>					/A030
  IFDEF V30NOR < TEXT 'DISKETT'>
  IFDEF V30SWE < TEXT 'DISKETTEN'>
  IFDEF DUTCH < TEXT 'DISKETTE'>
  IFDEF SPANISH <TEXT 'DISKETTE'>

DERVL1,									/A030
  IFDEF ENGLSH < TEXT 'VOLUME ON DEVICE'>				/A030
  IFDEF ITALIAN < TEXT /ARCHIVIO DOCUMENTI NELL'UNIT\@/	>		/A030
  IFDEF V30NOR < TEXT 'OMR\EDET P\E ENHET'>
  IFDEF V30SWE < TEXT 'VOLYMEN I ENHET'>
  IFDEF DUTCH < TEXT 'GEBIED OP AANDRIJVER'>
  IFDEF SPANISH < TEXT 'VOLUMEN EN DISPOSITIVO'>


DERVL2,									/A030
  IFDEF ENGLSH < TEXT 'VOLUME'>						/A030
  IFDEF ITALIAN < TEXT 'SUPPORTO'>					/A030
  IFDEF V30NOR < TEXT 'OMR\DE'>
  IFDEF V30SWE < TEXT 'VOLYMEN'>
  IFDEF DUTCH < TEXT 'GEBIED'>
  IFDEF SPANISH < TEXT 'VOLUMEN'>


DERDKV,									/A030
  IFDEF ENGLSH < TEXT 'DISKETTE/VOLUME'>				/A030
  IFDEF ITALIAN < TEXT 'SUPPORTO'>					/A030
  IFDEF V30NOR < TEXT 'DISKETT/OMR\DE'>
  IFDEF V30SWE < TEXT 'DISKETTEN/VOLYMEN'>
  IFDEF DUTCH  < TEXT 'DISKETTE/GEBIED'>
  IFDEF SPANISH< TEXT 'DISKETTE/VOLUMEN'>


TSDEV,									/A030
  IFDEF ENGLSH < TEXT 'DRIVE/DEVICE'>					/A030
  IFDEF ITALIAN < TEXT 'SUPPORTO'>					/A030
  IFDEF V30NOR < TEXT 'STASJON/ENHET'>
  IFDEF V30SWE < TEXT 'ENHET'>
  IFDEF DUTCH  < TEXT 'AANDRIVJER'>
  IFDEF SPANISH < TEXT 'UNIDAD/DISPOSITIVO'>


/XSDFNBUFFER,ZBLOCK FNSIZE+1^MXFLD+1	/MXFLD 12(10) FNSIZE+1 31(10) D007
					/CHAR BUFFER EACH KEY
					/SEPARATED BY [0]TERM
					/BUFFER ENDS WITH [-1] TERM
/THE XSDFNBUFFER BUFFER WILL BE DEFINED IN THE SORT FIELD DUE TO SPACE
/CONSTRAINTS IN EDIT FIELD
	
CUB1,	ZBLOCK 400
INBUF,	-STRLEN
	ZBLOCK STRLEN+1
	
	PAGE





