* Program........: CopyTo.PRG
* Author.........: Farivar Roshanian
* Date...........: Aug 2, 1989
* Version........: dBASE IV 1.0
* Notes..........: This procedure will copy the file currently
* in use then copy it to the filename specified
* and create the appropiate .MDX file.
* Parameters.....: mtarget
*
* To run the program
* DO CopyTo with ""
* where is the name of the file you want
* to copy to.
*
PARAMETERS mtarget
talkflag=SET("TALK")
exactflag=SET("EXACT")
confirmflag=SET("CONFIRM")
SET TALK OFF
SET EXACT ON
SET CONFIRM OFF
NULL=""

* -- store current status.
mfileopen=DBF()
mrecno=recno()
morder=ORDER()
* -- Verify that a database is open.
IF DBF()=NULL
? "No database in use"
RETURN
ENDIF
mselect=ALIAS()

* -- Copy the structure.
IF FILE("newtemp.dbf")
ERASE newtemp.dbf
ENDIF
COPY TO newtemp STRUCTURE EXTENDED

* -- Open the structure file in area 9.
SELECT 9
USE newtemp

* -- If the index file fieldname.ndx already exist, then erase it.
IF FILE("fieldname.ndx")
ERASE fieldname.ndx
ENDIF

* -- Index the file on Field_name
INDEX ON Field_name to fieldname
SELECT &mselect
ctr=1

* -- If there is a tag on a field, then modify the corresponding
* field in the structure file.
DO WHILE TAG(CTR)#NULL
mtagname=TRIM(TAG(ctr))
SELECT 9
SEEK mtagname
REPLACE Field_idx WITH "Y"
SELECT &mselect
ctr=ctr+1
ENDDO

* -- Close the structure file and erase the index file.
SELECT 9
USE
ERASE fieldname.NDX

* -- create a new file from the structure file.
SELECT &mselect
CREATE &mtarget from newtemp
APPEND FROM &mfileopen
USE &mfileopen
IF NULL#morder
SET ORDER TO TAG &morder
ENDIF
GO mrecno
ERASE newtemp.DBF
SET TALK &talkflag
SET EXACT &exactflag
SET CONFIRM &confirmflag
* EOP CopyTo