cwprdupl ; ;[ 01/12/99  1:09 PM ]
 ;
 Do INIT^vhTERMINA
 For  Do  Quit:'FromPRNr
 .Write @F11,@F1
 .Set FromPRNr=$$SELECT^PRODUKT6(,,,"Te dupliceren produkt ")
 .Quit:'FromPRNr  Quit:'$D(^PRLINK("IKM",FromPRNr))
 .Kill Data,Kind
 .For I=0:1:10 Quit:'$D(^KPR(FromPRNr,I))  Set Data(I)=^KPR(FromPRNr,I)
 .Set I=$O(^KPR(FromPRNr,"I"),-1)
 .For  Set I=$O(^KPR(FromPRNr,I)) Quit:$E(I)'="I"  Set Data(I)=^KPR(FromPRNr,I)
 .Set I=$O(^KPR(FromPRNr,"J"),-1)
 .For  Set I=$O(^KPR(FromPRNr,I)) Quit:$E(I)'="J"  Set Data(I)=^KPR(FromPRNr,I)
 .Merge Kind=Data
 .Set FP=203
 .Write @F,"Basis"
 .Set FP=303,IDNr=$P(Data(2),D,25)
 .Write @F,"Identnummer : ",IDNr
 .Set FP=403,KortTxt=$P(Data(0),D)
 .Write @F,"Korttekst   : ",KortTxt
 .Set $E(IDNr)=6,$P(Kind(2),D,25)=IDNr
 .Set $E(KortTxt,18,21)="*KP*",$P(Kind(0),D)=KortTxt
 .Set FP=703
 .Write @F,"Kind"
 .Set FP=803,IDNr=$P(Kind(2),D,25)
 .Write @F,"Identnummer : ",IDNr
 .Set FP=903,KortTxt=$P(Kind(0),D)
 .Write @F,"Korttekst   : ",KortTxt
 .Set FP=2201
 .Write @F,@F1
 .Read "Dupliceren ? ",R
 .Do:R="j" DUPLI
 Quit
 ;
DUPLI 
 Write *7
 ;Quit
 Do DELIND^PRODUKT2(FromPRNr)
 Set IDNr=$P(Kind(2),D,25),$P(^KPR(FromPRNr,2),D,25)=IDNr
 Set KortTxt=$P(Kind(0),D),$P(^KPR(FromPRNr,0),D)=KortTxt
 Do BLDIND^PRODUKT2(FromPRNr)
 Set ToPRNr=$$NEXTID^PRODUKT()
 Set $P(Data(0),D,6)="" ; Ligging
 Set $P(Data(0),D,9)="" ; Reservatie WMS
 Set $P(Data(0),D,12,14)=D_D ; Beginstock,FysStock
 Set $P(Data(0),D,16)="" ; Laatste beweging
 Set $P(Data(0),D,17)="" ; Bestelling
 Set $P(Data(0),D,20)="" ; Schaduwkorttekst
 Set $P(Data(0),D,21)="" ; Schaduw sectie
 Set $P(Data(1),D,21)="" ; Gem Weekverkoop
 Set $P(Data(1),D,23)="" ; Gewogen gem. weekverkoop
 Set $P(Data(1),D,9)="" ; Inventaris fysstock
 Set $P(Data(2),D,3)="" ; Schad PPL
 Set $P(Data(2),D,4)="" ; Schad Korting
 Set $P(Data(2),D,5)="" ; Schad Vork
 Set $P(Data(2),D,6)="" ; Schad Winst
 Set $P(Data(2),D,7)="" ; Schad Cif
 Set $P(Data(2),D,9)="" ; Reservatie
 Merge ^KPR(ToPRNr)=Data
 Do BLDIND^PRODUKT2(ToPRNr)
 s ^PRLINK("D",ToPRNr,FromPRNr)=1
 s ^PRLINK("IKM",FromPRNr,ToPRNr)=""
 Do ZEND^EWPR(FromPRNr),ZEND^EWPR(ToPRNr)
 Quit
 ;