TITLE	SRTTAB FOR RPGII 1
SUBTTL	SORT DIAGNOSTIC WORDS	AL BLACKINGTON/CAM/BOB CURRIER

;MODIFIED TO RPGII VERSION AUGUST 8, 1975 00:57:37 BOB CURRIER

TWOSEG
RELOC	400000

	ENTRY	SRTERA
	ENTRY	SRTNAM

;THE DATA CONSISTS OF ONE WORD ENTRIES
;THEY ARE SORTED DISREGARDING DIAGNOSTIC NUMBERS, SUCH THAT
;	ALL DIAGS FOR SAME POSITION WILL BE PRINTED IN THE ORDER
;	THAT THEY WERE WRITTEN ONTO ERAFIL

;THE DIAGS ARE CURRENTLY IN CORE, "ERATAB" POINTS TO THE FIRST ITEM,
;	"DT" POINTS TO THE LAST

SRTERA:	HRRZ	TA,ERATAB		; SET TA TO THE FIRST DIAG
	MOVEI	TC,0			; CLEAR FLAG

SRTER1:	CAIN	TA,(DT)			; ARE WE DONE?
	JRST	SRTER8			; YES -

	MOVE	TE,1(TA)

	MOVE	TD,0(TA)
	ANDCMI	TD,DIAGNO		; STRIP OFF DIAG NUMBER
	ANDCMI	TE,DIAGNO

	CAMLE	TD,TE			; ARE THEY IN ORDER?
	JRST	SRT10			; NO - EXCHANGE
	AOJA	TA,SRTER1		; YES - NO EXCHANGE


SRTER8:	JUMPN	TC,SRTERA		; ONE PASS DONE - ANY EXVHANGES?
	POPJ	PP,			; NO - THEY ARE ALL IN ORDER

;SINGLE FOLLOWED BY SINGLE EXCHANGE ROUTINE

SRT10:	MOVE	TB,0(TA)
	EXCH	TB,1(TA)
	MOVEM	TB,0(TA)

SRT11:	MOVNI	TC,1

SRT12:	AOJA	TA,SRTER1


DIAGNO==777				;MASK FOR DIAGNOSTIC NUMBER

EXTERNAL ERATAB

NAMRSV==1B2


SUBTTL	SORT USER NAMES IN NAMTAB		AL BLACKINGTON

;PACK POINTERS TO USER NAME AT TOP OF NM2TAB

SRTNAM:	MOVN	TA,NM12SZ
	MOVSS	TA
	HRR	TA,NM2LOC
	MOVEI	LN,(TA)
	HRRZ	CP,NAMLOC
	MOVSI	TD,CP

SRTN1:	SKIPN	TE,(TA)
	JRST	SRTN2

	HRR	TD,TE
	MOVE	TC,@TD
	TLNN	TC,NAMRSV/1000000
	TRNN	TC,-1
	JRST	SRTN2

	MOVEM	TE,(LN)
	ADDI	LN,1

SRTN2:	AOBJN	TA,SRTN1

;LN NOW POINTS TO LAST ENTRY PLUS 1

	SETZM	(LN)
;SORT NM2TAB ACCORDING TO NAMES IN NAMTAB

	MOVSI	TA,CP
	MOVSI	TB,CP

SRTN3:	HRRZ	TC,NM2LOC		; SET TO TOP OF TABLE
	MOVEI	DT,0
	SUBI	LN,1

SRTN4:	CAIL	TC,(LN)			; DONE WITH THIS PASS?
	JRST	SRTN9			; YES -

	HLRZ	TE,(TC)			; NO - GET SIZE OF ITEM-A
	HLRZ	TD,1(TC)		; GET SIZE OF ITEM-B
	HRR	TA,(TC)			; GET ADDRESS OF ITEM-A
	HRR	TB,1(TC)		; GET ADDRESS OF ITEM-B

SRTN5:	ADDI	TA,1
	ADDI	TB,1

	MOVE	CH,@TA			; GET A WORD FROM ITEM-A
	CAME	CH,@TB			; IS IT EQUAL TO WORD FROM ITEM-B
	JRST	SRTN8			; NO -

	SOJLE	TD,SRTN6		; YES - HAVE WE LOOKED AT ALL OF ITEM-B?
	SOJG	TE,SRTN5		;NO - HAVE WE LOOKED AT ALL ITEM-A?

SRTN5A:	AOJA	TC,SRTN4		; YES - THEY ARE EQUAL

SRTN6:	SOJLE	TE,SRTN5A		; HAVE WE LOOKED AT ALL ITEM-A?

SRTN7:	MOVE	TE,(TC)			; NO - ITEM-A IS LARGER, SO SWAP POINTERS
	EXCH	TE,1(TC)
	MOVEM	TE,(TC)

	HRROI	DT,-1			; SET FLAG

	AOJA	TC,SRTN4		; LOOP TO LOOK AT NEXT PAIR

SRTN8:	CAMG	CH,@TB			; IS ITEM-A > ITEM-B
	AOJA	TC,SRTN4		; NO - LOOP TO LOOK AT NEXT PAIR

	JRST	SRTN7			; YES - GO SWAP THEM

SRTN9:	JUMPN	DT,SRTN3		; ANYTHING SWAPPED ON THAT PASS?

	POPJ	PP,			; NO - RETURN

EXTERNAL	NAMLOC,NM2LOC,NM12SZ

	END