* **************************  DNTRANS COMMAND FILE  **************************
*
*                                  dNAMES 1.1
*                   (c) Copyright 1982 Data Based Solutions
*                             All Rights Reserved
* ****************************************************************************
&era
STORE ' ' TO abort
SET colon ON
CLEAR GETS
IF !($(dsk,1,1))#!($(dsk,2,1))
 @ 12,6 SAY 'This function currently can only be performed if you are using'
 @ 13,6 SAY 'the same drive for dNAMES COMMAND files and dNAMES DATA files.'
 @ 15,6 SAY 'Press any key.' GET abort PICTURE '!'
ELSE 
 @ 09,6 SAY 'This function transfers all records that are tagged for transfer' 
 @ 10,6 SAY 'to a BLANK FORMATTED diskette. It will then delete the' 
 @ 11,6 SAY 'tagged records in the master dNAMES files.' 
 @ 12,6 SAY 'This may take a few minutes depending on the size of your files.' 
 @ 13,6 SAY 'You need a BLANK FORMATTED diskette to complete this function.' 
 @ 15,6 SAY 'Type "Y" to continue or <RET> to abort. ' GET abort PICTURE '!' 
ENDIF
&con
READ
&coff
IF !(abort)# 'Y' .OR.!($(dsk,1,1))#!($(dsk,2,1))
 SET colon OFF
 RELEASE abort
 STORE f TO correct
 RETURN
ENDIF
IF FILE( 'DNN' ).AND.FILE( 'DNC' ).AND.FILE( 'DNMC' ).AND.FILE( 'DNdate' )
 STORE t TO correct
 STORE ' ' TO dsk2
 DO WHILE correct
  @ 17,6 SAY 'Enter destination drive (A-H) to be transfered to. ' ;
  GET dsk2 PICTURE '!' 
  &con
  READ
  &coff
  IF !(dsk2)= 'A' .OR.!(dsk2)= 'B' .OR.!(dsk2)= 'C' .OR.!(dsk2)= 'D' ;
   .OR.!(dsk2)= 'E' .OR.!(dsk2)= 'F' .OR.!(dsk2)= 'G' .OR.!(dsk2)= 'H' 
   @ 19,25
   @ 20,25
   STORE f TO correct
  ELSE
   SET inte OFF
   @ 19,25 SAY '*** INVALID DRIVE LETTER ***' 
   @ 20,25 SAY 'Must be between "A" and "H"' 
   SET inte ON
   LOOP
  ENDIF 
 ENDDO WHILE correct 
 STORE ' ' TO drive
 @ 18,6 SAY 'Put in a formatted diskette in the ' +dsk2+ ': drive ' +;
 'then type "' +!(dsk2)+'" ' GET drive PICTURE '!'
 &con
 READ
 &coff
 IF drive#dsk2
  RELE drive,dsk2,abort
  SET COLON OFF
  STORE f TO correct
  RETURN
 ENDIF
 SET INTE OFF
 @ 20,26 SAY '*** ONE MOMENT PLEASE ***'
 SET INTE ON
 STORE $(dsk,1,1) TO drive
 SET DEFA TO &dsk2
 RESET
 SET DEFA TO &drive
 RESET
 STORE dsk2+ ':dnn' TO ta1
 STORE dsk2+ ':dnxn.ndx' TO ta2
 STORE dsk2+ ':dnc' TO tb1
 STORE dsk2+ ':dnxc.ndx' TO tb2
 STORE dsk2+ ':dnmc' TO tc1
 STORE dsk2+ ':dnxmc.ndx' TO tc2
 STORE dsk2+ ':dnmem' TO tmem
 STORE dsk2+ ':dnrecl' TO tfile
 STORE dsk2+ ':dncl' TO trecl
 IF FILE( '&ta1' ).OR.FILE( '&tb1' ).OR.FILE( '&tc1' )
  SET inte OFF
  @ 20,6 SAY 'THE DISK YOU WANT TO TRANSFER RECORDS TO IS ALREADY ' +;
  'A dNAMES DATE DISK.' 
  SET inte ON
  @ 21,6 SAY 'Enter a blank formatted diskette or it will be copied over.' 
  @ 22,6 SAY 'Type <RET> to return to abort transfer or "'+!(dsk2)+;
  '" to continue.' 
  SET cons OFF
  WAIT TO abort
  SET cons ON
  IF !(abort)# !(dsk2)
   RELEASE dsk2,newnumber,abort,nnn,ta1,ta2,tb1,tb2,tc1,tc2
   STORE f TO correct
   SET colon OFF
   RETURN
  ENDIF
 ENDIF
 ERASE
 SET inte OFF
 @ 12,20 SAY "RELAX... I'll be done in a few minutes." 
 STORE $(dsk,1,1) TO drive
 SET DEFA TO &dsk2
 RESET
 SET DEFA TO &drive
 RESET
 IF FILE( '&ta1' ).OR.FILE( '&tb1' ).OR.FILE( '&tc1' )
  DELETE FILE &ta1
  DELETE FILE &ta2
  DELETE FILE &tb1
  DELETE FILE &tb2
  DELETE FILE &tc1
  DELETE FILE &tc2
  DELETE FILE &trecl
  DELETE FILE &tfile
 ENDIF
 USE dnrecl
 COPY TO &tfile
 USE dncl
 COPY TO &trecl
 SET inte ON
 SELECT seco
 USE dnmc
 COPY FOR mark= 'M' TO &tc1 
 delete all for mark= 'M' 
 USE &tc1
 REPLACE ALL mark WITH ' ' 
 INDEX ON cno TO &tc2
 USE &tc1 INDEX &tc2
 SELECT PRIMARY
 USE dnn
 COPY FOR $(code,2,1)= 'M' TO &ta1 
 delete all for $(code,2,1)= 'M' 
 USE &ta1
 REPLACE ALL code WITH $(code,1,1)+ ' ' 
 GO BOTTOM
 STORE headname TO theadname
 STORE headdate TO theaddate
 STORE trim(name) TO headname
 STORE DATE() TO headdate
 STORE mno TO tmno
 STORE # TO mno
 INDEX ON $(name,1,20) TO &ta2
 LOCATE FOR code= '*' 
 DO WHILE .not. eof
  STORE # TO newnumber
  STORE str(no,5) TO nnn
  SELECT seco
  FIND &nnn
  IF no#cno
   LOCATE FOR str(cno,5)=nnn
  ENDIF
  IF no=cno
   REPLACE cno WITH newnumber
  ENDIF
  SELECT PRIMARY
  CONTINUE
 ENDDO WHILE .not. eof 
 SELECT PRIMARY
 REPLACE ALL no WITH #
 INDEX ON $(name,1,20) TO &ta2
 SELECT seco
 USE &tc1
 INDEX ON cno TO &tc2
 USE dnc
 COPY FOR mark= 'M' TO &tb1 
 delete all for mark= 'M' 
 USE &tb1
 REPLACE ALL mark WITH ' ' 
 REPLACE ALL nno WITH #
 INDEX ON phone TO &tb2
 RELEASE correct,dsk2,newnumber,abort,nnn,ta1,ta2,tb1,tb2,tc1,tc2,drive,;
 tfile,trecl
 SAVE TO &tmem
 STORE tmno TO mno
 STORE theadname TO headname
 STORE theaddate TO headdate 
 SELE PRIM
 USE dnn INDEX dnxn
 SELECT seco
 USE dnc INDEX dnxc
 SELECT PRIMARY
 RELEASE dsk2,newnumber,abort,nnn,ta1,ta2,tb1,tb2,tc1,tc2,tmem,theadname,;
 theaddate,drive,tmno,tmem
 STORE f TO open
 STORE f TO correct
 SET colon OFF
 RETURN
ENDIF
RETURN