GENPROD ;Produkt duplicering voor manuele produkten[ 09/24/2003  8:35 AM ]
 ;
 Kill
 Do BUILD^A508
 Do INIT^vhTERMINA
 Set Q="K"
 Write @F11,@F1
 Set PRNr=$$GENERATE()
 Write !,"PRNr = ",PRNr,*7 r r
 Quit
 ;
GENERATE(Ref,GenPRNr,Params) 
 New sFL,FromPRNr,NewRec,NewPRNr,KLNr,LEVNr,Taal,IsStock
 Set Ref=$G(Ref),GenPRNr=$G(GenPRNr),Params=$G(Params),(KLNr,LEVNr,FromPRNr)=""
 Set:Params="K" KLNr=Ref Set:Params="L" LEVNr=Ref,IsStock=1
 If Params="",GenPRNr Do
 .Set R=$O(^KPR(GenPRNr,"J"))
 .Quit:$E(R)'="J"
 .Set R=^KPR(GenPRNr,R),LEVNr=$P(R,D)
 Set Taal=$G(KT,"N")
 Do BUILD,NEWREC
 Do NIEUW^vhScherm("GENPROD",,,,,,3)
 If %SC Do
 .For I=1:1:9 Set NewRec(I-1)=$G(sFL(I))
 .For I=10:1:15 Set:$L($TR($G(sFL(I)),D,"")) NewRec(I-1)=sFL(I)
 .For I="I","J" Set NewRec(I)=sFL(I)
 .Set NewRec("G")=$P(NewRec(1),D,20)_D_$P(NewRec("J"),D,2,99)
 .Do SAVE
 Quit $G(NewPRNr)
 ;
BUILD 
 If 'FromPRNr New FromPRNr Set FromPRNr=GenPRNr
 Do FETCHPR^UTILI(FromPRNr,"NewRec")
 Set LEVNr=$P(NewRec("J"),D)
 Set $P(NewRec(0),D)="MAN...",$P(NewRec(0),D,3)=GenPRNr
 Do CLEAN
 Quit
 ;
CLEAN 
 Set $P(NewRec(0),D,6)="" ; Ligging
 Set $P(NewRec(0),D,12,14)=D_D ; Beginstock,FysStock
 Set $P(NewRec(0),D,16)="" ; Laatste beweging
 Set $P(NewRec(0),D,17)="" ; Bestelling
 Set $P(NewRec(0),D,20)="" ; Schaduwkorttekst
 Set $P(NewRec(0),D,21)="" ; Schaduw sectie
 Set $P(NewRec(1),D,9)="" ; Inventaris fysstock
 Set $P(NewRec(1),D,20)=$G(IsStock) ; Stock/niet stock
 Set $P(NewRec(1),D,21)="" ; Gem Weekverkoop
 Set $P(NewRec(1),D,23)="" ; Gewogen gem. weekverkoop
 Set $P(NewRec(2),D,3)="" ; Schad PPL
 ;Set $P(NewRec(2),D,4)="" ; Schad Korting
 ;Set $P(NewRec(2),D,5)="" ; Schad Vork
 ;Set $P(NewRec(2),D,6)="" ; Schad Winst
 ;Set $P(NewRec(2),D,7)="" ; Schad Cif
 Set $P(NewRec(2),D,9)="" ; Reservatie
 If LEVNr=5005 Set $P(NewRec(2),D,25)=8_$E($P(NewRec(2),D,25),2,99) ; Identnummer
 Else  Set $P(NewRec(2),D,25)=""
 If GenPRNr=FromPRNr Do
 .Set $P(NewRec(0),D,2)="" ; Omschrijving N1
 .Set $P(NewRec(0),D,11)="" ; Omschrijving N2
 .Set $P(NewRec(1),D,22)="" ; Omschrijving F1
 .Set $P(NewRec(2),D,25)="" ; Identnummer
 .Set $P(NewRec(3),D,21)="" ; Omschrijving F2
 .Set $P(NewRec("J"),D,3)="" ; Leveranciersref
 .;Set $P(NewRec("J"),D,24)=50 ; DB%
 .Set $P(NewRec("J"),D,10)=20 ; KSDB%
 .Set $P(NewRec("J"),D,19)="" ; Aankoopprijs
 .Set $P(NewRec("J"),D,25)="" ; Lijstprijs
 Quit
 ;
NEWREC 
 For I=0:1:$O(NewRec(20),-1) If $D(NewRec(I)) Set sFL(I+1)=NewRec(I)
 For I="I","J" Set sFL(I)=NewRec(I)
 Quit
 ;
SAVE 
 Set NewPRNr=$$NEXTID^PRODUKT()
 If $P(NewRec(2),D,25)="" Set IdentNr=$$IDENTNR^PRODUKT(NewPRNr),$P(NewRec(2),D,25)=IdentNr
 Set:$P(NewRec(0),D)="MAN..." $P(NewRec(0),D)="MAN "_NewPRNr
 For I=0:1:5 Set ^KPR(NewPRNr,I)=NewRec(I)
 For I=6:1:14 Set:$TR($G(NewRec(I)),D,"")'="" ^KPR(NewPRNr,I)=NewRec(I)
 Set:$D(NewRec("G")) ^KPR(NewPRNr,"G")=NewRec("G") ; Generische node
 Set ^KPR(NewPRNr,"I")=""
 Set ^KPR(NewPRNr,"I1")=NewRec("I")
 Set ^KPR(NewPRNr,"J")=""
 Set ^KPR(NewPRNr,"J"_$P(NewRec("J"),D))=NewRec("J")
 ;Indexen
 Do RECALC^PRODUKT2(NewPRNr)
 Do BLDIND^PRODUKT2(NewPRNr)
 Do Gemaakt^PRODUKT2(NewPRNr)
 Do ZEND^EWPR(NewPRNr)
 Quit
 ;
INPBREF 
 New B,U2,I,J,Empty,Node
 Set U2=$P(sFR,"`",3)_";;;;"_($P(sFR,"`",5)+1)_";"_$P(sFR,"`",6)_";;;"_$P(sFR,"`",10)
 If $G(GenPRNr)=36945!($G(GenPRNr)=64421)!($G(GenPRNr)=73220) Do
 .Set Node=$S(Taal="F":9,Taal="D":11,Taal="E":13,1:7),Empty=1
 .For I=5,6 Quit:'Empty  For J=1:1:3 Set Empty='$L($P(sFL(I),D,J)) Quit:'Empty
 .Quit:'Empty
 .For I=4:1:7 Set Empty='$L($P(sFL(5),D,I)) Quit:'Empty
 .Quit:'Empty
 .If Taal="F" Set $P(sFL(5),D)=$P(sFL(2),D,22),$P(sFL(5),D,2)=$P(sFL(4),D,21)
 .Else  If Taal="D" Set $P(sFL(5),D)=$P(sFL(3),D,2),$P(sFL(5),D,2)=$P(sFL(4),D,23)
 .Else  If Taal="E" Set $P(sFL(5),D)=$P(sFL(3),D),$P(sFL(5),D,2)=$P(sFL(4),D,22)
 .Else  Set $P(sFL(5),D)=$P(sFL(1),D,2),$P(sFL(5),D,2)=$P(sFL(1),D,11)
 .Set $P(sFL(5),D,3)=$P(sFL(Node),D)
 .For I=1:1:3 Set $P(sFL(6),D,I)=$P(sFL(Node),D,I+1)
 .For I=4:1:7 Set $P(sFL(5),D,I)=$P(sFL(Node),D,I+1)
 Merge B=sFL
 For  Do  Quit:$P(B(2),D,20)  Quit:$L($P(B(5),D))  Quit:LEVNr=5005  Quit:zb=-2
 .Do INPBREF^PRODUKT2()
 .If zb=-2 Set:$D(sDir) sDir=-1
 .Else  Set:$D(sDir) sDir=1 Set %SC=1
 Merge sFL=B
 Quit
 ;
INPLTEXT(Taal) 
 New B,U2,zb
 Set U2=$P(sFR,"`",3)_";;;;"_($P(sFR,"`",5)+1)_";"_$P(sFR,"`",6)_";;;"_$P(sFR,"`",10)
 Merge B=sFL
 For  Do  Quit:Taal="N"&$L($P(B(1),D,2))  Quit:Taal="F"&$L($P(B(2),D,22))  Quit:Taal="D"&$L($P(B(3),D,2))  Quit:Taal="E"&$L($P(B(3),D))  Quit:zb=-2
 .Do INPLTEXT^PRODUKT2(Taal)
 .If zb=-2 Set:$D(sDir) sDir=-1
 .Else  Set:$D(sDir) sDir=1 Set %SC=1
 Merge sFL=B
 Quit
 ;
PRIJS(AKPrijs,VKPrijs) 
 New %DB,B,K,P24
 If $D(AKPrijs),$D(VKPrijs) Do
 .Set AKPrijs=AKPrijs/$S($P(sFL("J"),D,28)="H":100,$P(sFL("J"),D,28)="M":1000,1:1)
 .Set AKPrijs=AKPrijs/$$MUNTPAR^vhRtn1($P(sFL("J"),D,17),1)*(100-$P(sFL("J"),D,9)/100)*(100+$P(sFL("J"),D,21))/100
 .Set %DB=$J(1-($J(AKPrijs,0,4)/VKPrijs)*100,0,4)
 .Set $P(sFL("J"),D,24)=%DB
 Else  If $D(AKPrijs) Do
 .Set AKPrijs=AKPrijs/$S($P(sFL("J"),D,28)="H":100,$P(sFL("J"),D,28)="M":1000,1:1)
 .Set VKPrijs=AKPrijs/$$MUNTPAR^vhRtn1($P(sFL("J"),D,17),1)*(100-$P(sFL("J"),D,9)/100)
 .Set VKPrijs=VKPrijs*(100+$P(sFL("J"),D,21)/100)/(100-$P(sFL("J"),D,24)/100),VKPrijs=$J(VKPrijs,1,4)
 .Set $P(sFL("J"),D,25)=VKPrijs
 Else  If $D(VKPrijs) Do
 .Set VKPrijs=VKPrijs/(100+$P(sFL("J"),D,21)/100)*(100-$P(sFL("J"),D,24)/100)
 .Set AKPrijs=VKPrijs*$$MUNTPAR^vhRtn1($P(sFL("J"),D,17),1)/(100-$P(sFL("J"),D,9)/100)
 .Set AKPrijs=AKPrijs*$S($P(sFL("J"),D,28)="H":100,$P(sFL("J"),D,28)="M":1000,1:1)
 .Set AKPrijs=$J(AKPrijs,1,$P(^KBA(11,$P(sFL("J"),D,17)),D,7))
 .Set $P(sFL("J"),D,19)=AKPrijs
 Set B(1)=sFL("J"),P24=1
 Do ^KP0
 Set sFL("J")=B(1)
 Quit
 ;
 Quit
 ;
RECALC(Prijs,ScrnTyp) 
 New R,X
 Set ScrnTyp=$G(ScrnTyp)
 If "V"[Prijs Do
 .Do PRIJS($P(sFL("J"),D,19))
 .Do DISPLAY^vhScherm("GENPROD"_ScrnTyp,"","","","LIJSTPR")
 If "A"[Prijs Do
 .If ScrnTyp="D",$P(sFL("J"),D,19) Do
 ..Do PRIJS($P(sFL("J"),D,19),$P(sFL("J"),D,25)),DISPLAY^vhScherm("GENPROD"_ScrnTyp,"","","","DB")
 .Else  Do PRIJS(,$P(sFL("J"),D,25)),DISPLAY^vhScherm("GENPROD"_ScrnTyp,"","","","AANKPR")
 Quit
 ;
RUBREXEC(Input) 
 New R,%SCTemp,sFLTemp,BasisTyp,Type,Hoogte,Breedte,Afm
 If Input="D" Do
 .Quit:'$$ASK^vhWACHTW("MANAGER")
 .Set %SCTemp=%SC
 .Merge sFLTemp=sFL
 .Do EDIT^vhScherm("GENPRODD",,,,,,3)
 .If '%SC Set %SC=%SCTemp Kill sFL Merge sFL=sFLTemp Quit
 .Do DISPLAY^vhScherm("GENPROD","","","","AANKPR;GROOTORD;KORTING;LIJSTPR")
 Else  If X="-",LEVNr=6092!(LEVNr=6428) Do
 .Set R=$P(sFL(4),D,20),BasisTyp=$P(R,";"),Type=$P(R,";",2),Afm=$P(R,";",3)
 .Set Hoogte=$P(Afm,"x"),Breedte=$P(Afm,"x",2)
 .If 'Hoogte,'Breedte Set $P(sFL(4),D,20)=""
 .Else  Do
 ..If Hoogte,Breedte Set (BasisTyp,Type)="",$P(sFL(4),D,20)=BasisTyp_";"_Type_";"_Afm
 ..Else  Do
 ...Set:'Hoogte Hoogte="?" Set:'Breedte Breedte="?"
 ...Set Hoogte=$J(Hoogte,$L($S(Hoogte>Breedte:Hoogte,1:Breedte)))
 ...Set Breedte=$J(Breedte,$L($S(Breedte>Hoogte:Breedte,1:Hoogte)))
 ...Set:'Hoogte Hoogte="ŞB"_Hoogte_"Şb" Set:'Breedte Breedte="ŞB"_Breedte_"Şb"
 ...Set X=$$^vhTXTPOP("GENPROD","CHKAFM",,Hoogte,Breedte)
 Quit
 ;
FROMPRNR(FromPRNr) 
 New R,X
 If '$G(FromPRNr) Do
 .Do STORE^vhTERMINA()
 .Set FromPRNr=$$SELECT^PRODUKT6($S($G(LEVNr):"L",1:""),$G(LEVNr),"","Basisprodukt : ",,".[] zonder basisprodukt")
 .Do REFRESH^vhTERMINA()
 .Set:FromPRNr="." FromPRNr=""
 .If $L(FromPRNr),'FromPRNr Quit
 .Do BUILD,NEWREC
 .;Quit:'FromPRNr
 .For Rubriek=1:1 Quit:'$D(sScrnDef(Rubriek))  Do DISPLAY^vhScherm(sScrn,"","","",Rubriek)
 Quit FromPRNr
 ;
KORTTEXT(Prompt,OldKortT) 
 New KortT
 Set OldKortT=$G(OldKortT)
 For  Set KortT=$$ASK^vhINP(Prompt,25,OldKortT,"","","","","","U") Quit:".-"[KortT  Quit:$$CHECKKT(KortT)
 Quit KortT
 ;
CHECKKT(KortT,PRNr) 
 New K,Check,ExistKt
 Set Check=1
 Set ExistKt=$$EXISTKT^PRODUKT2(KortT,$G(PRNr))
 If ExistKt Set Check=0 Xecute ^cTXT(0,"N",67) Read K
 Else  Set:$TR($E(KortT,22,25)," ","")'="" Check=$$EXISTKK^PRODUKT2(KortT,1)
 Quit Check
 ;
LABEL(Routine) ;Manueel produkt
 New Label
 Set Label=Routine
 Quit:Routine?4.7N "" ; Produkt
 If $D(^$ROUTINE(Routine)) Do
 .Xecute "Set R=$t(LABEL^"_Routine_")"
 .Set:$L($P(R,";",2)) Label=$P(R,";",2)
 Quit "G:"_Label
 ;
PUTAFM(BasisTyp,Type,Hoogte,Breedte) 
 New X
 Set:'$D(BasisTyp) BasisTyp=$P($P(sFL(4),D,20),";")
 Set:'$D(Type) Type=$P($P(sFL(4),D,20),";",2)
 Set:'$D(Hoogte) Hoogte=$P($P($P(sFL(4),D,20),";",3),"x")
 Set:'$D(Breedte) Breedte=$P($P($P(sFL(4),D,20),";",3),"x",2)
 Set:'Hoogte Hoogte="" Set:'Breedte Breedte=""
 Set X=BasisTyp_";"_Type_";"_Hoogte_"x"_Breedte
 Quit X
 ;
 ; Opvragen van het generisch produkt bij wijzigen producten
GenerischProduct(PRNr,NoWachtW)
 New GenPRNr,Tekst
 If $S($G(NoWachtW):1,1:$$ASK^vhWACHTW("MANAGER",,,0)) Do
 . Set GenPRNr=$$ASK^vhINP($P(U2,";")_" : ",$P(U2,";",9),"",$P(U2,";",10),"([] = vorig   )[] = volgend",3,,,,$P(U2,";",11))
 . If GenPRNr="." For  Set GenPRNr=$$SELECT^PRODUKT6(,,,"Generisch product : ") Quit:GenPRNr="-"  Do:GenPRNr  Quit:GenPRNr
 . . If GenPRNr=PRNr Set Tekst="Ongeldige ingave!~Mag niet zichzelf zijn!" Do WARN^vhTXTPOP(Tekst,"") Set GenPRNr="" Quit
 . . Set R=^KPR(GenPRNr,0),GenProd=$P(R,D,3)
 . . If GenProd'="",GenProd'?4.7N
 . . Else  Set Tekst="Ongeldige ingave!~"_$P(R,D)_" is geen generisch product!" Do WARN^vhTXTPOP(Tekst,"") Set GenPRNr=""
 Quit $G(GenPRNr,"-")
 ;