.TITLE	PURGER ... Purge unwanted records from database
.IDENT	/120582/
.ENABL	LC
;
;
;	Written by	Ray Di Marco
;			12-May-82.
;
;
;___________________________________________________________________________
;
; This is the main module for the PURGER program, which when assembled and
; linked with the database library, and optionally with the user template,
; is used to purge selected records from the database.
;
; The program requires that the user specify a SELECT format file that 
; contains a list of records to be deleted. The program can be envoked
; from the DBSMNG menu program, in which case it will accept input from
; core common commands.
;
;
;

.SBTTL	Declarations
;
.MCALL	.PUSH,.POP			; Stacking
.MCALL	CNAF				; Binary -> Ascii
.MCALL	.EXIT				; Abort Exit
;
;
.GLOBL	$$FORM				; Index for DBS support routines
.GLOBL	FORM$$				; Start of database format block
.GLOBL	DBSLDR				; Database loader
.GLOBL	SFLINT,SFLINP			; entries
.GLOBL	SFLNME,SFLPAR			; data structures
.GLOBL	FILINT,FIL.KW,KEY$$B		; DBSSUP - 'FILEIO'
.GLOBL	CON.ST,CON.LI,CON.CO,CON.EX	; "CONIO"
;
;
;
	.PSECT	CODE			; OPEN CODE SECTION
;	------	----
;

.SBTTL	Macro Definitions
;
;
.MACRO	PRINT	STR=R0
	.GLOBL	CON.LO
	MOV	STR,R0
	CALL	CON.LO
.ENDM	PRINT
;
;
.MACRO	GTLIN	BUF=R0,STR
	.IF	NB,STR
		.GLOBL	CON.LO
		MOV	STR,R0
		CALL	CON.LO
	.ENDC
	MOV	BUF,R0
	.GLOBL	CON.LI
	CALL	CON.LI
.ENDM	GTLIN
;
;
.MACRO	FATAL	STR,?A,?B
	PRINT	#'B
	.EXIT
B':	.ASCIZ	|'STR'|
.EVEN
.ENDM	FATAL
;

.SBTTL	INITIALIZATION SECTION
;
;
;	Initialize important parameters such as buffer size and name
;	of files to be used. We use the CONIO module to do I/O, so
;	must initialize this first.
;
START:	CALL	CON.ST			; initialize TTY interface
	PRINT	#7000$			; identify self
	TST	$$FORM			; is template linked in?
	BNE	100$			;  yes -> skip
	GTLIN	#TMPBUF,#7010$		; get template name
	MOV	#TMPBUF,R0		; R0 -> name
	CALL	DBSLDR			; load template
	MOV	R0,$$FORM		; save load address in pointer
;
100$:	GTLIN	#SFLNME,#7100$		; get name of 'SEL' file
	GTLIN	#TMPBUF,#7200$		; request confirmation
	CMPB	TMPBUF,#'Y		; got a 'Yes'?
	BEQ	PURGE			;  yes -> go restore
	JMP	CON.EX			;  no  -> exit time
;
.NLIST	BIN
7000$:	.ASCIZ	/Purger RDM110582/
7010$:	.ASCII	/		DB Template: /<200>
7100$:	.ASCII	/		Select File: /<200>
7200$:	.ASCII	/     Really PURGE database? /<200>
.EVEN
.LIST	BIN
;

.SBTTL	Routine - "PURGE"	...	purge records
;
;	Gain access to needed files and initialize loop counter.
;
PURGE:	CALL	SFLINT			; access backup file
	CALL	FILINT			; open data base
	CLR	ENTNUM			;	initialize entry number
;
;	Exit if all entries have been processed.
;
100$:	CMP	ENTNUM,SFLPAR+2		;	done all entries
	BHIS	500$			;	 yes -> exit
	INC	ENTNUM			;	doing next entry
;
	MOV	#TMPBUF,R0		; R0 ->	buffer
	MOV	SFLPAR,R1		; R1 =	entry size
	CALL	SFLINP			;	input data
	CLR	KEY$$B			;	ensure key=0
	MOV	TMPBUF,R0		; R0 =	key number
	CALL	FIL.KW			;	output key
	BR	100$			;	loop
;
500$:	JMP	CON.EX			;	exit time
;

.SBTTL	Variables
;
;
	.PSECT	$SCRTH			; open scratch area
;	======	======
;
$$FORM:	.WORD	FORM$$			; pointer to template
ENTNUM:	.WORD	0			; used as loop pointer
TMPBUF:	.BLKB	100			; temporary buffer
;
;
.END	START