PRDUPLI ;Product duplicering [ 12/16/2003  11:36 AM ]
 If '$D(Q) Set Q="K" D ^cA604,INIT^vhTERMINA
 Set PRNr=""
 For  Quit:PRNr="-"  Do
 .Do TITEL
 .Set PRNr=$$SELECT^PRODUKT6("","","","Te dupliceren product : ",,,,,,1)
 .Set FP=1901
 .Write @F,@F1
 .Write:PRNr @F,"Te dupliceren product : ",$P(^KPR(PRNr,0),D)
 .Quit:'$$CHECK()
 .Do DUPLI
 .Set X=$$WIJZIG^PRODUKT(NewPRNr,1)
 .Do MailHaefele^PRODUKT(NewPRNr,"D") ; Mail naar Haefele
 .Quit  ; Volgens JB en JDR is het vervolg niet nodig
 .Quit:'$$CHECKOP()
 .Do DUPLI
 .Set X=$$WIJZIG^PRODUKT(NewPRNr,1)
 .Do MailHaefele^PRODUKT(NewPRNr,"D") ; Mail naar Haefele
 Quit
 
CHECK() Quit:'PRNr 0
 ;Quit:$D(^KPR(PRNr,"G")) 0
 ;If $L($P(^KPR(PRNr,0),D,3)),$P(^KPR(PRNr,0),D,3)?.N Quit 0
 Set IdentNr=$P(^KPR(PRNr,2),D,25)
 Set Key=$O(^KPR(PRNr,"J")) Quit:$E(Key)'="J" 0
 Set LevNr=$P(^KPR(PRNr,Key),D)
 Set Stop=0
 Set LevNr=$$SELECT^LEVER(1,LevNr,"Eventueel andere leverancier : ")
 If 'LevNr Quit 0
 If LevNr=5005 For  Do  Quit:Stop
 .Set IdentNr=$$ASK^vhINP("Ingave nieuw identnummer : ",11,IdentNr,,,,,,"E")
 .If ".-"[IdentNr Set Stop=1 Quit
 .Set:IdentNr?8N IdentNr=$E(IdentNr)_"."_$E(IdentNr,2,4)_"."_$E(IdentNr,5,7)_"."_$E(IdentNr,8)
 .If '$$IsValidIdentNr^PRODUKT2(IdentNr) Do TXT^vhINP("Identnummer heeft foutief formaat") Quit  ;[IDENT] CW
 .;If "0,1,2,3,5,4,6,7,8"'[$E(IdentNr)!(IdentNr="") Do TXT^vhINP("Foutief beginnummer voor een identnummer") Quit  ;[IDENT] CW
 .Set Som=$E(IdentNr,3)*6+($E(IdentNr,4)*5)+($E(IdentNr,5)*4)+($E(IdentNr,7)*3)+($E(IdentNr,8)*2)#11
 .Set CheckD=$S(Som=0:1,Som=1:0,1:11-Som)
 .; Index kan op raad van BLUM verhoogd worden
 .For Index=1:1:1 Quit:$E(IdentNr,9)=CheckD  Do
 ..Set CheckD=$S(Som+Index<11:11+Index-Som,1:0)
 .Set CheckD=$E(CheckD,$L(CheckD))
 .If $E(IdentNr,9)'=CheckD  Do  ; Controle tweede wijze voor parts, promotion en catalogues
 ..Set Som=$E(IdentNr,3)*1+($E(IdentNr,4)*3)+($E(IdentNr,5)*1)+($E(IdentNr,7)*3)+($E(IdentNr,8)*1)+($E(IdentNr,9)*3)#10
 ..Set CheckD=10-Som
 ..If $E(IdentNr,11)'=CheckD  Do  ; Controle tweede wijze
 ...Do TXT^vhINP("IdentNummer met mogelijk foutieve checkdigit") Quit
 ..Else  Do  ; Controle tweede wijze
 ...Do TXT^vhINP("IdentNummer OK, dit voor onderdelen, promotieartikelen en katalogen") Quit
 .If $D(^KPR2($$TRIMIDENT^vhRtn1(IdentNr)_" ")) Do TXT^vhINP("IdentNr bestaat reeds") Quit  ;[IDENT] CW
 .Set Stop=2
 If LevNr'=5005 For  Do  Quit:Stop  
 .Set Stop=0
 .Set IdentNr=$$ASK^vhINP("Ingave nieuw identnummer (eerste karakter) : ",1,$E(IdentNr))
 .If ".-"[IdentNr Set Stop=1 Quit
 .If "1,2,3,4,6,7,8,9"'[IdentNr Do TXT^vhINP("Foutief beginnummer voor een identnummer") Quit
 .Set Stop=2
 Quit:Stop=1 0
 Set KortT=$$NEXTABD^PRODUKT2(PRNr) Quit:KortT="-" 0 Set:KortT="" KortT=$P(^KPR(PRNr,0),D,1)
 Set DossierRef=$$DossierRef^PRODUKT2(PRNr)
 Do:$L(DossierRef)
 . New Dossier,DosPar,DosPos
 . Set NieuwDossier=$$^vhTXTPOP("PRDUPLI","MODDOSSIER","",KortT)
 . Quit:'NieuwDossier
 . Set DosPar=$$DOSPAR(DossierRef,"????"),DosPos=$P(DosPar,";"),Dossier=$P(DosPar,";",2)
 . Xecute "Set $e(KortT,"_DosPos_")=Dossier"
CHECK1 Set Stop=0
 If LevNr=5005,$D(^BLProd("D",0_$$TRIMN^vhRtn1($E(IdentNr,2,99)))) Set KortT=$P(^BLProd("D",0_$$TRIMN^vhRtn1($E(IdentNr,2,99))),D) ; Product bestaat in ^BLProd
 For  Do  Quit:Stop
 .Set KortT=$$KORTTEXT^PRODUKT2("Ingave nieuwe korttekst : ",KortT)
 .Set Stop=$S(".-"[KortT:1,1:2)
 Quit Stop=2
 
CHECKOP() 
 Set PRNr=NewPRNr
 Set KortT=$$NEXTABD^PRODUKT2(PRNr,1) Quit:KortT="-" 0
 Do TITEL
 Goto CHECK1
 
DUPLI
 New Dossier,DosPar,DosPos
 If $G(NieuwDossier) For  Do  Quit:$$CHECKKT^PRODUKT2(KortT)
 . Set DosPar=$$DOSPAR(DossierRef),DosPos=$P(DosPar,";"),Dossier=$P(DosPar,";",2)
 . Xecute "Set $e(KortT,"_DosPos_")=Dossier"
 Set NewPRNr=$$NEXTID^PRODUKT()
 If LevNr'=5005 Set IdentNr=$$IDENTNR^PRODUKT(NewPRNr,IdentNr)
 For I=0:1:15 Set:$D(^KPR(PRNr,I)) ^KPR(NewPRNr,I)=^KPR(PRNr,I)
 Set Key=$O(^KPR(PRNr,"I")) 
 If $E(Key)="I" Set IKey=Key,^KPR(NewPRNr,Key)=^KPR(PRNr,Key),^KPR(NewPRNr,"I")=""
 Set Key=$O(^KPR(PRNr,"J")) 
 If $E(Key)="J" Set R=^KPR(PRNr,Key)
 Set $P(R,D,1)=LevNr,$P(R,D,17)=$P(^KLE(^KL1(LevNr),0),D,11)
 Set:$P(R,D,17)="" $P(R,D,17)=$$FADEF^vhRtn1() ; Belgische leverancier -> Munt=""
 Set (JKey,J)="J"_LevNr,^KPR(NewPRNr,J)=R
 Set ^KPR(NewPRNr,"J")=""
 Set $P(^KPR(NewPRNr,0),D,1)=KortT ; Korttekst
 Set $P(^KPR(NewPRNr,0),D,6)="" ; Ligging
 Set:$P(^KPR(NewPRNr,0),D,8)="" $P(^KPR(NewPRNr,0),D,8)="C#C" ; ABC klas
 Set $P(^KPR(NewPRNr,0),D,9)="" ; Reservatie WMS
 Set $P(^KPR(NewPRNr,0),D,12,14)=D_D ; Beginstock,FysStock
 Set $P(^KPR(NewPRNr,0),D,16)="" ; Laatste beweging
 Set $P(^KPR(NewPRNr,0),D,17)="" ; Bestelling
 Set $P(^KPR(NewPRNr,0),D,20)="" ; Schaduwkorttekst
 Set $P(^KPR(NewPRNr,0),D,21)="" ; Schaduw sectie
 Set $P(^KPR(NewPRNr,0),D,24)="" ; ScanType
 Set $P(^KPR(NewPRNr,0),D,28)="" ; OpeningDatum
 Set:$P(^KPR(NewPRNr,1),D)="" $P(^KPR(NewPRNr,1),D)=1 ; Productgroep
 Set $P(^KPR(NewPRNr,1),D,3)="" ; Schad Munt
 Do  ; Bufferweken
 .If '$P(^KPR(NewPRNr,1),D,20) Set $P(^KPR(NewPRNr,1),D,17)=""
 .Else  Set:'$P(^KPR(NewPRNr,1),D,17) $P(^KPR(NewPRNr,1),D,17)=2
 Set $P(^KPR(NewPRNr,1),D,21)="" ; Gem Weekverkoop
 Set $P(^KPR(NewPRNr,1),D,23)="" ; Gewogen gem. weekverkoop
 Set $P(^KPR(NewPRNr,1),D,9)="" ; Inventaris fysstock
 Set $P(^KPR(NewPRNr,2),D,3)="" ; Schad PPL
 Set $P(^KPR(NewPRNr,2),D,4)="" ; Schad Korting
 Set $P(^KPR(NewPRNr,2),D,5)="" ; Schad Vork
 Set $P(^KPR(NewPRNr,2),D,6)="" ; Schad DB
 Set $P(^KPR(NewPRNr,2),D,7)="" ; Schad Cif
 Set $P(^KPR(NewPRNr,2),D,9)="" ; Reservatie
 Set $P(^KPR(NewPRNr,2),D,10)="" ; Schad KSDB
 Set $P(^KPR(NewPRNr,2),D,14)="" ; BarcodeWaarde
 Set $P(^KPR(NewPRNr,3),D,3)="" ; KS-Prijslijst NIET verschijnen
 Set $P(^KPR(NewPRNr,15),D,5)="" ; Herbestelsurplus
 Set $P(^KPR(NewPRNr,15),D,6)="" ; Herbestelafronding
 Set $P(^KPR(NewPRNr,JKey),D,22)="" ; Max Logsteuer
 Set $P(^KPR(NewPRNr,2),D,25)=IdentNr ; IdentNummer
 If $L($P(^KPR(NewPRNr,0),D,3)) Do ; Generisch/ Afgeleid
 . Set X=$$^vhTXTPOP("PRDUPLI",$S($P(^KPR(NewPRNr,0),D,3)?4.7N:"AFGELEID",1:"GENERISCH"),"",$E($S($P(^KPR(NewPRNr,0),D,3)?4.7N:$P(^KPR($P(^KPR(NewPRNr,0),D,3),0),D),1:$$LABEL^GENPROD($P(^KPR(NewPRNr,0),D,3))),1,35))
 . Set:X="N" $P(^KPR(NewPRNr,0),D,3)=""
 . Set:X="A" $P(^KPR(NewPRNr,0),D,3)=PRNr ; Afgeleid
 Else  Set $P(^KPR(NewPRNr,1),D,12)=";BP" ; Controle status op 'Eenmalig PM'
 If $P(^KPR(NewPRNr,JKey),D,18) Set X=$$^vhTXTPOP("PRDUPLI","BPRIJS") Set:X $P(^KPR(NewPRNr,JKey),D,18)=""
 If $P(^KPR(NewPRNr,1),D,25) Set X=$$^vhTXTPOP("PRDUPLI","NONAKT") Set:X $P(^KPR(NewPRNr,1),D,25)=""
 If $P(^KPR(NewPRNr,JKey),D,18) Set X=$$^vhTXTPOP("PRDUPLI","BPRIJS") Set:X $P(^KPR(NewPRNr,JKey),D,18)=""
 If $P(^KPR(NewPRNr,JKey),D,27)'=40 Set X=$$^vhTXTPOP("PRDUPLI","VORK","",40)
 If $P(^KPR(NewPRNr,0),D,24) Set X=$$^vhTXTPOP("PRDUPLI","LIMIET")
 Set Klas=$P(^KPR(NewPRNr,IKey),D,4),Winst=$J($P(^KLAS("K",Klas),D,11)*100,0,2)
 Set:+Winst=(Winst\1) Winst=$J(Winst,0,0)
 Set WinstBeh=0
 If +$P(^KPR(NewPRNr,JKey),D,24)'=+Winst,+Winst Set X=$$^vhTXTPOP("PRDUPLI","WINST",0,$P(^KPR(NewPRNr,JKey),D,24),Winst),WinstBeh=1 Set:X $P(^KPR(NewPRNr,JKey),D,24)=Winst,WinstBeh=0
 If $L($P(^KPR(NewPRNr,1),D,19)) Set X=$$^vhTXTPOP("PRDUPLI","KATPRIJS") Set:X $P(^KPR(NewPRNr,1),D,19)="",$P(^KPR(NewPRNr,1),D,18)=""
 If LevNr=5005 Do BLUM
 ;Indexen
 Do BLDIND^PRODUKT2(NewPRNr)
 Do RECALC^PRODUKT2(NewPRNr)
 Do Gemaakt^PRODUKT2(NewPRNr)
 
 ;Copieren van de kinderen
 If $D(^PRBS("BS",PRNr)) Do  ; Heeft kinderen
 .Set X=$$^vhTXTPOP("PRDUPLI","COPYKIND","",$P(^KPR(PRNr,0),D,1))
 .If X Do  ;Copieren
 .. New %J
 .. Set %J=$$%J^vhRtn1()
 .. Kill ^HULP(%J)
 .. Do FETCH^PRBS(PRNr)
 .. Do SAVE^PRBS(NewPRNr)
 
 Do ##class(BL.Legacy.PRDUPLI).KopieerVerpakking(PRNr,NewPRNr)
 Do ##class(BL.Legacy.PRDUPLI).KopieerKenmerken(PRNr,NewPRNr)
 Do ##class(BL.Legacy.PRDUPLI).KopieerImages(PRNr,NewPRNr)
 
 Quit
copy
	s PRNr=483079
	s NewPRNr=483080
  If ##class(BL.Prod.ImageLink).HasImage(PRNr) Do  ; Heeft images
 . Set X=$$^vhTXTPOP("PRDUPLI","COPYIMAGE","",$P(^KPR(PRNr,0),D,1))
 . If X Do  ;Copieren
 . . Do ##class(BL.Prod.ImageLink).CopyViaPRNr(PRNr,NewPRNr)
 q
BLUM New BLID,BLRec,BLPrijs,MinBH,Prijs,Winst,Kort,GVP,NVP,KVP,GO,BPrijs,Txt,LeverTermijn,AantalPerPallet
 Set $P(^KPR(NewPRNr,J),D,3)=$E(IdentNr,3,99) ; LevRef
 Set BLID=$TR(IdentNr,".","")
 Set $E(BLID)=0
 Set BLRec=$G(^BLProd("D",BLID))
 If '$L(BLRec) Set X=$$^vhTXTPOP("PRDUPLI","BLUMNOTFOUND",0,KortT,IdentNr) Quit
 Set Txt=0
 Set BLPrijs=$$PRIJS^Blum.RaadplegenProduct(BLID,$P(^KPR(NewPRNr,J),D,18))
 Set BPrijs=$P(^KPR(NewPRNr,J),D,18)
 Set Prijs=$J($P(BLPrijs,D,1),0,2)
 Set:+Prijs=(Prijs\1) Prijs=$J(+Prijs,0,0)
 Set MinBH=$P(BLPrijs,D,7)
 Set GO=$P(BLPrijs,D,2)
 Set LeverTermijn=$$ICCode2LeverweekID^BLPROD(BLID),AantalPerPallet=$$AantalPerPalletID^BLPROD(BLID)
 If +Prijs Do  ; Prijs
 .Set $P(^KPR(NewPRNr,JKey),D,19)=Prijs
 .Set $P(^KPR(NewPRNr,JKey),D,28)=GO
 .Set Txt=Txt+1,Txt(Txt)=$S(BPrijs:"B",1:"A")_"-Prijs : "_Prijs_" /"_GO
 Else  Set Txt=Txt+1,Txt(Txt)="Prijs   : NIET ingevuld"
 If $P(BLPrijs,D,5)="N" Set Txt=Txt+1,Txt(Txt)="          ªBExterne specificatie : Netto prijsªb"
 If $P(BLPrijs,D,5)="B" Set Txt=Txt+1,Txt(Txt)="          ªBExterne specificatie : Bruto prijsªb"
 Set Kort=$P(BLPrijs,D,3)*100
 Set:+Kort=(Kort\1) Kort=$J(+Kort,0,0)
 Set Klas=$P(^KPR(NewPRNr,IKey),D,4),Winst=$J($P(^KLAS("K",Klas),D,11)*100,0,2)
 If $P(BLPrijs,D,5)="N" Set (Kort,Winst)="" ; ES specificatie : Nettoprijs
 If +Winst Do  ; Korting
 .Set $P(^KPR(NewPRNr,JKey),D,9)=Kort
 .Set:'WinstBeh $P(^KPR(NewPRNr,JKey),D,24)=Winst
 .Set Txt=Txt+1,Txt(Txt)="Korting : "_Kort_"%"
 .Set:'WinstBeh Txt=Txt+1,Txt(Txt)="Winst   : "_Winst_"%"
 Else  Set Txt=Txt+1,Txt(Txt)="Korting : NIET ingevuld"
 If LeverTermijn Do  ; Levertermijn
 . Set $P(^KPR(NewPRNr,JKey),D,7)=LeverTermijn
 . Set Txt=Txt+1,Txt(Txt)="Levertrm: "_LeverTermijn
 Else  Set Txt=Txt+1,Txt(Txt)="Levertrm: NIET ingevuld"
 If MinBH Do  ; Min. Bestelhoeveelheid
 .Set $P(^KPR(NewPRNr,JKey),D,6)=MinBH
 .Set Txt=Txt+1,Txt(Txt)="MinBH   : "_MinBH
 Else  Set Txt=Txt+1,Txt(Txt)="MinBH   : NIET ingevuld"
 Set GVP=$P(BLRec,D,6),NVP=$P(BLRec,D,5),KVP=$P(BLRec,D,4)
 Set:'GVP GVP=NVP,NVP=KVP,KVP=""
 Set:'GVP GVP=NVP,NVP="",KVP=""
 Set:'NVP NVP=KVP,KVP=""
 If GVP Do  ; Verpakking
 .Set $P(^KPR(NewPRNr,JKey),D,16)=GVP
 .Set $P(^KPR(NewPRNr,JKey),D,15)=NVP
 .Set $P(^KPR(NewPRNr,JKey),D,14)=KVP
 .Set Txt=Txt+1,Txt(Txt)="Verpak  : "_GVP_$S(NVP:"/"_NVP,1:"")_$S(KVP:"/"_KVP,1:"")
 Else  Set Txt=Txt+1,Txt(Txt)="Verpak  : NIET ingevuld"
 If $P(BLRec,D,9) Do  ; Gewicht
 .Set $P(^KPR(NewPRNr,1),D,13)=$P(BLRec,D,9)
 .Set Txt=Txt+1,Txt(Txt)="Gewicht : "_$P(BLRec,D,9)
 Else  Set Txt=Txt+1,Txt(Txt)="Gewicht : NIET ingevuld"
 If $L($P(BLRec,D,20)) Do  ; EANCode
 .Set $P(^KPR(NewPRNr,2),D,14)=$P(BLRec,D,20)
 .Set Txt=Txt+1,Txt(Txt)="EAN Code: "_$P(BLRec,D,20)
 Else  Set Txt=Txt+1,Txt(Txt)="EAN Code: NIET ingevuld"
 If AantalPerPallet Do  ; Aantal per pallet
 .Set $P(^KPR(NewPRNr,2),D,16)=AantalPerPallet
 .Set Txt=Txt+1,Txt(Txt)="# Pallet: "_AantalPerPallet
 Else  Set Txt=Txt+1,Txt(Txt)="# Pallet: NIET ingevuld"
 Set X=$$WILD^vhTXTPOP("","Overdracht BLUM-gegevens",$NA(Txt),"")
 Quit
 
TITEL 
 Write @F11,@F1,@FMTI,"PRODUCT DUPLICERING - ",QN,@FMTi
 Quit
 
 ; Geef de parameters voor het plaatsen van een dossier vb '8,11;  CT'
DOSPAR(DossierRef,Dossier)
 New DosPar,Pos,Allign,Length
 Set Dossier=$G(Dossier,$$NextDossier^PRODUKT2(DossierRef))
 Set DosPar=$P($P($P("HDNR;8,11;L\POMNR;8,11;L\TBXNR;8,11;L\TLMNR;8,11;L\GLNR;8,11;R\SDMNR;8,11;R\MATNR;9,11;L\PLNR;5,8;L\SGNR;7,10;R",DossierRef,2),D),";",2,3)
 Set Pos=$P(DosPar,";"),Allign=$P(DosPar,";",2),Length=$P(Pos,",",2)-$P(Pos,",")+1
 Set Dossier=$E(Dossier,1,Length)
 If Allign="L" Set Dossier=Dossier_$J("",Length-$L(Dossier))
 Else  Set Dossier=$J("",Length-$L(Dossier))_Dossier
 Quit Pos_";"_Dossier