.TITLE DIRHDR - OUTPUT LISTING HEADER
	.IDENT	/8MAR82/
	.ENABLE	GBL
;+
;*****
;
;	DIRHDR.MAC - .DRHDR SUBROUTINE TO PUT HEADER TO LISTING DEVICE.
;	 NOTE: HEADER RECORD WILL BE BUILT IN "PRMPT" BUFFER, OUTPUT TO
;	 LISTING DEVICE AND STANDARD OUTPUT RECORD POINTER IN LISTING FDB
;	 WILL BE RESTORED TO WHATEVER (USUALLY #LINBUF)
;
;	  SPECIAL CASE WHEN DELETE SWITCH IS SET FOR DELETION AND LISW 
;	  IS CLEAR FOR NO LISTING--SKIP HEADER.
;
;
;	SUBROUTINES REQUIRED:
;	 .DRPUT - MOVES OUTPUT RECORD TO LISTING DEVICE
;
;	PAUL SORENSON
;	PULMONARY RESEARCH
;	S3, MAYO CLINIC
;	ROCHESTER, MN 55904
;
;*****
;-
	.PSECT	$PDATA,D,RO,LCL,CON,REL
	.ENABL	LC
HDR1:	.ASCIZ	/Directory /		;DIRECTORY HEADER
	.EVEN
HDR2:	.ASCIZ	/Files deleted /
	.EVEN
	.DSABL	LC

	.PSECT	$CODE1,I,RO,LCL,CON,REL

.DRHDR::			;ENTRY POINT

	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	BIT	#HDSW,SWMSK$	; HEADER ALREADY PRINTED?
	BNE	15$		; BRANCH IF YES
	BIT	#DESW!PUSW,SWMSK$	;DOING DELETE OR PURGE ?
	BEQ	4$		;NO, GET DIRECTORY HEADER
	BIT	#LISW,SWMSK$	;DELETE WITH LISTING ?
	BEQ	15$		;NO, SKIP HEADER
	MOV	#HDR2,R1	;YES, FETCH DELETE HEADER
	BR	5$
4$:	MOV	#HDR1,R1	;SET UP ADDRESS OF DIRECTORY HEADER
5$:	MOV	#PRMPT,R0	;FETCH ADDRESS OF BUFFER FOR HEADER RECORD
	MOV	LSTFDB+F.NRBD+2,(R0)+	;STORE CURRENT RECORD POINTER AT
					; HEAD OF NEW RECORD
	MOV	R0,LSTFDB+F.NRBD+2	;SETUP NEW LISTING RECORD POINTER
	CALL	.DRPUT		;OUTPUT NULL LINES FOR SPACING
	CALL	.DRPUT
	MOV	#" *,(R0)+	;FLAG THE HEADER
	MOV	#"* ,(R0)+
	BIT	#SDSW,SWMSK$	;DOING SELECTIVE DELETE ?
	BNE	7$		;YES, SKIP WORD "DIRECTORY" IN HEADER
6$:	MOVB	(R1)+,(R0)+	;MOVE OUT HEADER WORD
	BNE	6$		;IF NE, MORE CHARACTERS TO GO
	DEC	R0		;BACK UP OVER 0
7$:	MOV	#SAVFNB+N.DVNM,R1	;FETCH POINTER TO DEVICE NAME FIELD
	MOVB	(R1)+,(R0)+	;COPY THE DEVICE NAME
	MOVB	(R1)+,(R0)+
	MOV	(R1),R1	;GET THE UNIT NUMBER
	ASR	R1		;DIV BY 10(8)
	ASR	R1		;...
	ASR	R1		;...
	BEQ	8$		;BR IF UNIT # < 10(8)
	ADD	#'0,R1		;TURN IT INTO ASCII
	MOVB	R1,(R0)+	;PUT IT IN O/P BUFFER
8$:	MOV	SAVFNB+N.UNIT,R1	;GET IT AGAIN
	BIC	#^C<7>,R1	;MAKE IT 0-7
	ADD	#'0,R1		;TURN IT INTO ASCII
	MOVB	R1,(R0)+	;PUT IN O/P BUFFER
	MOVB	#':,(R0)+	;PLANT USUAL DELIMITER
	MOVB	#'[,(R0)+	;SET UIC DELIMITER
	MOV	SAVFNB+N.FNAM,R1 ;GET DIRECTORY NAME
	CALL	20$		;CONVERT GROUP NAME TO ENGLISH
	MOVB	#',,(R0)+	;SEPARATE GROUP & USER
	MOV	SAVFNB+N.FNAM+2,R1 ;GET OTHER HALF OF NAME
	CALL	20$		;CONVERT PROGRAMMER NUMBER
	MOVB	#'],(R0)+	;TERMINATE UIC
	MOVB	#' ,(R0)+	;SEPARATE
	MOV	#DATIM$,R1	;POINT AT DATE & TIME
	MOV	R0,R2		;COPY CURRENT POINTER
10$:	MOVB	(R1)+,(R0)+	;FILL IN DATE
	BNE	10$		;FINISH DATE ?
	DEC	R0		;YES, BACK UP OVER NULL
12$:	CMPB	(R2)+,#'-	;LOOK FOR FIRST DATE DELIMITER
	BNE	12$		; LOOP TIL FOUND
	INC	R2		;POINT TO LAST 2 CHARACTERS IN MONTH
	BISB	#40,(R2)+	;MAKE THEM LOWER CASE
	BISB	#40,(R2)+
	CALL	.DRPUT		;PRINT THAT
	CALL	.DRPUT		;SEND NULL LINE
	BIS	#HDSW,SWMSK$	;FLAG HEADER PRINTED
	MOV	PRMPT,LSTFDB+F.NRBD+2	;RESTORE NEXT RECORD POINTER TO 
;					; ORIGINAL VALUE
15$:	MOV	(SP)+,R2	;RESTORE REGISTERS
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;*****
;
;	LOCAL SUBROUTINE TO CONVERT UIC
;
;*****
20$:	MOV	R0,-(SP)	;SAVE START POINT
	CALL	$C5TA		;CHANGE TO ASCII
	MOV	(SP)+,R2	;GET TOP OF LIST
	DEC	R0		;BACK UP TO LAST CHAR IN STRING
30$:	CMPB	R2,R0		;ALL DONE?
	BHIS	50$		;BR IF YES
	CMPB	#'0,(R2)	;LEADING ZERO?
	BNE	50$		;BR IF NO
	MOVB	1(R2),(R2)	;MOVE UP STRING
	MOVB	2(R2),1(R2)	;
	DEC	R0		;SHORTEN STRING
	BR	30$		;TRY FOR MORE
50$:	INC	R0		;RESET POINTER PAST STRING
	RETURN
	.END	;.DRHDR