$! **********************************************************************
$! * ONE.COM								*
$! *   Delete all versions of specified file except the latest, then	*
$! *   rename latest version to version one. Will purge file specified	*
$! *   as first parameter (wildcards allowed) or all files in current	*
$! *   directory if no parameter is specified.				*
$! *									*
$! *	04-JAN-1993	RDJ	Command Procedure Creation.		*
$! *									*
$! *	15-SEP-1999	RDJ	Modified to make use of F$Parse to get	*
$! *				file specification from P1.		*
$! **********************************************************************
$   Set NoVerify
$! ***
$   DefFileSpec = F$Environment("Default") + "*.*"
$				! default file specification
$   ComProc = F$Parse(F$Environment("Procedure"),,,"Name")
$				! name of this procedure
$   Files = 0			! total number of files processed
$   Wildcard_Purge = "TRUE"	! wildcard specified in argument?
$   Search_Thread_Main = 1	! main f$search thread number
$   Search_Thread_Purge = 2	! f$search thread for purge subroutine
$! ***
$   If P1 .EQS. "" Then -
      Write SYS$OUTPUT "%''ComProc'-W-ALLFILES, Processing all files in current directory"
$!
$   Files2Process = F$Parse(P1,DefFileSpec,,"Device") + -
                    F$Parse(P1,DefFileSpec,,"Directory") + -
                    F$Parse(P1,DefFileSpec,,"Name") + -
                    F$Parse(P1,DefFileSpec,,"Type")
$!
$   If (F$Locate("*",Files2Process) .EQ. F$Length(Files2Process)) .AND -
       (F$Locate("%",Files2Process) .EQ. F$Length(Files2Process)) Then -
      Wildcard_Purge = "FALSE"		! wildcard purge?
$!
$ Get_Next_File:			! Get next file in directory
$   FileSpec = F$Search(Files2Process,Search_Thread_Main)
$   If FileSpec .EQS. "" Then -
      Goto No_More_Files
$   Files = Files + 1
$   Call Purge_File 'FileSpec' 'Search_Thread_Purge'
$   If Wildcard_Purge Then Goto Get_Next_File
$!
$ No_More_Files:			! No more files found; print status
$   If Files .EQ. 0
$     Then
$       Write SYS$OUTPUT "%''ComProc'-W-NOFILES, No files purged"
$     Else
$       Write SYS$OUTPUT "%''ComProc'-S-FILES, ''Files' file(s) purged"
$     EndIf
$   Exit
$!
$! **********************************************************************
$! * Purge_File: Process an individual filename.			*
$! *	P1 = Individual filename to process.				*
$! *	P2 = F$Search thread number.					*
$! **********************************************************************
$ Purge_File: SubRoutine
$   ComProc = F$Parse(F$Environment("Procedure"),,,"Name")
$   File = F$Parse(P1,,,"Device") + F$Parse(P1,,,"Directory") + -
        F$Parse(P1,,,"Name") + F$Parse(P1,,,"Type")
$   If F$Search(File,P2) .EQS. ""
$     Then
$       Write SYS$OUTPUT "%''ComProc'-E-BADFILE, File not found ''File'"
$     Else
$       Purge/NoLog/NoConfirm 'File'
$       Rename 'File'; 'File';1
$       Write SYS$OUTPUT "%''ComProc'-S-PURGED, File purged: ''File'"
$     EndIf
$   Exit
$ EndSubRoutine	! Purge_File