#include %Prod.Product
PRBS ;Product bouwstenen[ 12/10/2003  11:25 AM ]
 Do VERWERK() q
 ;
HasHalfFabr(PRNr,NoSa)
	New HasHalfFabr,BSKey
	Set HasHalfFabr=""
	Set BSKey=""
	Set BSNode=$S($G(NoSa)="S":"BSS",1:"BS")
	For  Set BSKey=$O(^PRBS(BSNode,PRNr,BSKey)) Quit:BSKey=""  Do  Quit:HasHalfFabr
	. Set HasHalfFabr=$P(^PRBS(BSNode,PRNr,BSKey),"\",3)="H"
	Quit HasHalfFabr
	
GetMoederKindFactor(Moeder,Kind)
	New Result Set Result = 1
	New KindGevonden Set KindGevonden = 0
	New Index Set Index=""
	For  Set Index=$O(^PRBS("BS",Moeder,Index)) Quit:Index=""  Quit:KindGevonden  Do
	. Set Rec=^PRBS("BS",Moeder,Index)
	. If $P(Rec,D,1)=Kind Set KindGevonden=1 If $P(Rec,D,3)="K" Set Result=$P(Rec,D,2)
	Quit Result
 
 
	
VERWERK(MPRNr,Raadpl,FabKey) 
 New %SC,zb,sMod,NoMod,BSDefCod,BSSelect,Input,List,Result,DataNoSa,CalcNoSa
 New:'$G(RPLPR) Input
 
 Set (DataNoSa,CalcNoSa)="" ; Normaal
 Do INIT
 Do:$G(MPRNr)'?4.7N ASKPR Quit:MPRNr'?4.7N
 Do LOCK(MPRNr)
 Do SYNCPR^HADWIZ(MPRNr)
 Do FETCH(MPRNr,DataNoSa)
 Do REFRESH
 If Input="-"
 Else  If NoMod Do
 . Do WARN^vhTXTPOP("Product beveiligd, wijzigen niet mogelijk!")
 Else  If $L(NoMod),"OR"[NoMod Do WARN^vhTXTPOP("Product opgenomen in het WMS, wijzigen niet mogelijk!") Set NoMod=1
 For  Quit:(Input="-")!(Input=".")  Do COMMAND
 ; de controle wordt alleen uitgevoerd als NoPrijs is false en alleen voor producten met halfabrikaten of voor producten met 'STOCK OVER KINDEREN'
 Set:'$G(NoPrijs)&&'$G(NoMod)&&($$HasHalfFabr^PRBS(MPRNr)||($$$ProductGet(MPRNr,$$$LinkType)="S")) Result=$$CONTROLE^PRBSC(MPRNr)
 Quit
 ;
RAADPL(PRNr,RPLPR,FabKey) 
 Set RPLPR=$G(RPLPR)
 Do VERWERK(PRNr,1,$G(FabKey))
 Set:RPLPR VTB=$G(U4),SW2=0,R=Input
 Quit
 ;
OPEN(Dir) ; Volgend product openen 
 New PRNr
 ; oud product
 If $G(Dir)="SYNC" Do  ; Synchronisatie via producttree
 . Read Dir
 . Set:$E(Dir)="." Dir=$E(Dir,2,99)
 . Set:Dir'?4.7N Dir=""
 . If Dir?4.7N,'$D(^KPR(Dir)) Set Dir=""
 
 Set Input="SAVE"
 Do ASKSAVE(.Input)
 Do SAVE(MPRNr,DataNoSa):(Input="-")!(Input="SAVE")
 Set:'$G(NoPrijs)&'$G(NoMod) Controle=$$CONTROLE^PRBSC(MPRNr)	
 Do UNLOCK(MPRNr)
 ;
 If $G(Dir)?4.7N Do  ; Jumpproduct
 . Set PRNr=Dir
 Else  If '$G(Dir) Do  ; via SELECT
 . Do STORE^vhTERMINA()
 . Set PRNr=$$SELECT^PRODUKT6(,,,,"NODO;NOKP")
 . Do REFRESH^vhTERMINA()
 Else  Do
 . Set PRNr=$$NEXT^PRODUKT("K",MPRNr,Dir,1)
 Quit:PRNr'?4.7N 
 Set MPRNr=PRNr
 Set (DataNoSa,CalcNoSa)="" ; terugn naar normaal voor volgend product
 Do INIT
 Do LOCK(MPRNr)
 Do SYNCPR^HADWIZ(MPRNr)
 Do FETCH(MPRNr,DataNoSa)
 Do REFRESH
 Quit
 
COMMAND 
 Set Input=$$SCROLL^vhLIST(.List)
 Set BSSelect=$S(List("SELECT"):$P(^HULP(%J,"L",List("SELECT")),D,20),1:"")
 If Input="COM" Set Input="" Do CALL^vhMenu("PRBS")
 ;If Input="SPEC" Set Input="" Do CALLSPEC^vhMenu(List("POS")+List("SELECT")_";80","PRBSS","E")
 Quit:Input=""
 Do EXEC^vhMenu("PRBS",.Input)
 Do ASKSAVE(.Input)
 Do SAVE(MPRNr,DataNoSa):(Input="-")!(Input="SAVE")
 Do AskVersion(MPRNr):(Input="-")!(Input="SAVE")
 Do UNLOCK(MPRNr)
 Quit
 ;
AskVersion(MPRNr)
	New Input
	Quit:$P(^PRBS("BS",MPRNr),"\",3)=""
	Set Input=$$^vhTXTPOP("PRBS","CLEARVERSION",,$P(^PRBS("BS",MPRNr),"\",3))
	If Input="W" Do WisVersion(MPRNr)
	Quit
WisVersion(MPRNr)
	Set $P(^PRBS("BS",MPRNr),"\",3)=""
	Quit
 
ASKTYPE ; Bij een nieuw eindproduct moet het type gevraagd worden
 New Meta
 Set Meta=$$PI^vhPOPUP("C;C","KO1","Type","PRBS","META")
 Quit:Meta=""
 Set $P(^HULP(%J,"C"),D,2)=Meta
 Set $P(^HULP(%J,"C"),D,1)=$P(^RES("PRBS","PI","META","D",Meta),"`",4)
 Do GETPOP
 Do REFRESH
 Quit
 
ASKPR ; Vragen van een product
 Write @F11,@F1
 Do DISPLAY^vhScherm("PRBSHFD")
 Set MPRNr=$$SELECT^PRODUKT6()
 Quit
 
DUPLI(PRNr,NoSa) ; Dupliceren van (intern aan CHUI)
 Do STORE^vhTERMINA()
 Set:$G(PRNr)'?4.7N PRNr=$$SELECT^PRODUKT6(,,,"Dupliceren van product : ")
 Do REFRESH^vhTERMINA()
 Quit:PRNr'?4.7N
 Set BSNode=$S($G(NoSa)="S":"BSS",1:"BS")
 Do:'$D(^PRBS(BSNode,PRNr)) WARN^vhTXTPOP("Het product "_$P(^KPR(PRNr,0),D)_" heeft geen "_$S($G(NoSa)="S":"schaduw",1:"")_"bouwstenen")
 Do FETCH(PRNr,.NoSa)
 Do REFRESH 
 Set sMod=1
 Quit
 
DELETE New I
 Quit:'$$^vhTXTPOP("PRBS","DELETE")
 For I="C","L","S","V" Kill ^HULP(%J,I) ; het eigenlijk verwijderen uit ^PRBS gebeurt bij de save
 Do REFRESH 
 Set sMod=1
 Quit
 
 ;¨**** LIJN NIEUW, WIJZIG & DELETE ****
NIEUWLBL()  ; Menu item met default BSCode
 Quit "Nieuw "_$S($L(BSDefCod):$P(^RES(BSPopGrp,"PI",BSPopNm,"D",BSDefCod),"`",2),1:"...")
 
LNIEUW(BSDefCod)  ; Nieuw bouwsteen
 New %SC,BSCode,BSKey,SchermNm
 If '$D(^HULP(%J,"C")) Do ASKTYPE ; Nog niet gedefinieerd
 If $L($G(BSDefCod)) Do
 .Set BSCode=BSDefCod
 Else  Do  Quit:BSCode=""
 .Set BSCode=$$PI^vhPOPUP("C;C","BKO1-","Bouwsteen",BSPopGrp,BSPopNm)
 Set BSKey=$$DEFBSKEY(BSCode)
 ; Controle uniciteit
 If BSKey="" Do WARN^vhTXTPOP("De code "_BSCode_" mag maar 1 keer gebruikt worden") Quit
 Set SchermNm="PRBSDTL"_$$SCRNTYP(BSKey)
 Do NIEUW^vhScherm(SchermNm,,,,,,3)
 If %SC Do  ; Type van 
 . Set BSSelect=BSKey
 . Set sMod=1
 . Do UPDATE
 Quit
 
NEWDEF(BSKey) ; Defaulting bij nieuw bouwsteen
 ;vult rechtstreeks sFL in nl. sFL(1) en eventueel sFL("D")
 New Rec
 Quit:BSPopGrp=""
 Set Rec=$G(^RES(BSPopGrp,"PI",BSPopNm,"D",$P(BSKey,".")))
 Quit:Rec=""
 Set $P(sFL(1),D,2)=1 ;Aantal
 Set $P(sFL(1),D,11)=$P(Rec,"`",7) ; Groep
 Set $P(sFL(1),D,3)=$P(Rec,"`",3) ; BSType
 Quit
 
LWIJZIG ; Wijzigen bouwsteen
 New %SC,BSKey,SchermNm
 Quit:BSSelect=""
 Set BSKey=BSSelect
 Set SchermNm="PRBSDTL"_$$SCRNTYP(BSKey)
 Do EDIT^vhScherm(SchermNm,,,,,,3)
 Set:%SC sMod=1
 Do:%SC UPDATE
 Quit
 
LDELETE ; Verwijderen bouwsteen
 New %SC,BSKey,SchermNm
 Quit:BSSelect=""
 Kill ^HULP(%J,"C",BSSelect)
 Do UPDATE
 Set sMod=1
 Quit
 
MEERW ; Meerwaarde toggle
 New Meerw
 Quit:BSSelect=""
 Set Meerw=$P(^HULP(%J,"C",BSSelect),D,16)
 Set $P(^HULP(%J,"C",BSSelect),D,16)=$S(Meerw:"",1:1)
 Do UPDATE
 Set sMod=1
 Quit
 
UPDATE 
 Do CALCC(.PrijsTree,1)
 Do UPDATE^vhLIST(.List,1)
 Do DISPLAY^vhScherm("PRBSHFD",,,,"PPL;KOST;TIJD;TIJDOM;SCHAD;VERSIE",1)
 Quit
 
CALCKOST ; Opgeroepen vanuit vhScherm 
 ; Berekenen van de verwerkingskost uitgaande van de tijd en kostplaats
 Set Tijd=$$GET^vhScherm("TIJDKOST")
 Set KostPlaats=$$GET^vhScherm("KOSTPLAATS")
 Quit:KostPlaats="" 
 Set oKostPlaats=##class(Prod.GAMeta.BT.KostPlaats).%OpenId(KostPlaats)
 Set Kost=Tijd*oKostPlaats.GetBasisKost(.NoSa)/3600
 Do PUT^vhScherm("VERWERKING",Kost)
 Set Kost=Kost*oKostPlaats.GetToeslagKleinVerlet(.NoSa)
 Do PUT^vhScherm("KLVERLET",Kost)
 Set Kost=Kost*oKostPlaats.GetToeslagGrootVerlet(.NoSa)
 Do PUT^vhScherm("GRVERLET",Kost)
 Quit
 
DEFBSKEY(BSCode) ; Opzoeken van een eerst vrij BSKey Nummer
 New BSKey,VolgNr
 Set BSKey=$O(^HULP(%J,"C",$P(BSCode,".")_".999"),-1)
 Set VolgNr=$S($P(BSKey,".")=$P(BSCode,"."):$P(BSKey,".",2)+1,1:1)
 If VolgNr>1,$L(BSPopNm),$P($G(^RES(BSPopGrp,"PI",BSPopNm,"D",$P(BSKey,"."))),"`",4) Quit "" ; Uniek: mag maar 1 maal voorkomen
 Quit $P(BSCode,".")_"."_$TR($J(VolgNr,3)," ","0")
 
SCRNTYPVia(Ref) ; SCRNTYP voor transfert
 If Ref'["^HULP" Quit ""
 Quit ";"_$$SCRNTYP($P(@Ref,D,20))
 
SCRNTYP(BSKey) ; Welk detail scherm er gebruikt moet worden
 Set BSTyp=$P($G(^HULP(%J,"C",BSKey)),D,3)
 Set:BSTyp="" BSTyp=$P(^RES(BSPopGrp,"PI",BSPopNm,"D",$P(BSKey,".")),"`",3)
 If BSTyp="K" Quit "K"
 If BSTyp="H" Quit "H"
 If BSTyp="S" Quit "S"
 If BSTyp="T" Quit "T"
 If BSTyp="L" Quit "L"
 Quit ""
 
CBLIST(Select,BSRec) ; Callback van vhLIST om de juiste lijstdef te bepalen
 Quit $$SCRNTYP($P(sRec,D,20))
 
 ; ***** GLOBAL ACCESS FETCH & SAVE
FETCH(PRNr,NoSa)   
 Set IsOrgal=$E($P($G(^KPR(PRNr,0)),D,1),1,2)="OL"
 Set BSNode=$S($G(NoSa)="S":"BSS",1:"BS")
 Kill ^HULP(%J,"C")
 Merge ^HULP(%J,"C")=^PRBS(BSNode,PRNr)
 Do FETCHLNK(PRNr)
 If $D(^HULP(%J,"C")),'$D(^PRBS(BSNode,PRNr)) Do  ;Alleen links
 . Set ^HULP(%J,"C")="M\KP"
 Do GETPOP
 Quit
 
FETCHLNK(PRNr) 
 New LPRNr,Cnt,BSCode,Rec
 Set LPRNr="",Cnt=0
 For  Set LPRNr=$O(^PRBS("LNK",PRNr,LPRNr)) Quit:LPRNr=""  Do
 .Set Rec=LPRNr_D_1_D_"L"
 .Set $P(Rec,D,12)=^PRBS("LNK",PRNr,LPRNr)
 .Set Cnt=Cnt+1
 .Set BSCode="L."_$E(Cnt+1000,2,4)
 .Set ^HULP(%J,"C",BSCode)=Rec
 Quit
 
GETPOP ; Ophalen van welke popup er moet gebruikt worden voor de bouwsteencodes
 ; Definieert volgende locals : BSPopGrp, BSPopNm, BSDefCod, EindTyp
 New Meta,BSPopup,Rec,BSKey
 Set Meta=$P($G(^HULP(%J,"C")),D,2)
 Set (BSPopGrp,BSPopNm,BSDefCod)=""
 Quit:Meta=""
 Set Rec=$G(^RES("PRBS","PI","META","D",Meta))
 Set BSPopup=$P(Rec,"`",3)
 Quit:BSPopup=""
 Set BSPopGrp=$P(BSPopup,";")
 Set BSPopNm=$P(BSPopup,";",2)
 Set BSDefCod=$P(Rec,"`",5)
 If $L(BSDefCod),'$D(^RES(BSPopGrp,"PI",BSPopNm,"D",BSDefCod)) Set BSDefCod="" ; '$D(^RESD(... vervangen door '$D(^RES(... op 25.10.07 door CW
 Set EindTyp=$P($G(^HULP(%J,"C")),D,1)
 Quit
 
SORT ; Sorteren van de cache volgens SORTKEY
 New BSKey,Rec,SortKey 
 Kill ^HULP(%J,"S")
 Set BSKey=""
 For  Set BSKey=$O(^HULP(%J,"C",BSKey)) Quit:BSKey=""  Do
 .Set BSRec=^HULP(%J,"C",BSKey)
 .Set SortKey=$$SORTKEY(BSKey,BSRec)
 .Set ^HULP(%J,"S",SortKey)=BSRec
 Quit
 
SORTKEY(BSKey,Rec) 
 New SortKey
 Set SortKey=(1000+$P(Rec,D,10))_";"_$S($P(Rec,D,11)="*":"~",1:$P(Rec,D,11))_";"_BSKey ; Indien groep is wildcard dan achteraan sorteren
 ;Set SortKey=$P(Rec,D,10)_";"_$S($P(Rec,D,11)="*":"~",1:$P(Rec,D,11))_";"_$P(Rec,D,10)_";"_BSKey ; Indien groep is wildcard dan achteraan sorteren
 Quit SortKey
 
LOCK(PRNr,Optie) 
 New Ask
 Set Ask=$$LOCKW^vhLock($G(Optie,"NXR"),$NA(^PRBS("BS",PRNr)),$NA(^PRBS("BSS",PRNr)))
 Set:Ask="X" Input="-" ; Exit 
 If 'Ask Set NoMod=1 Quit
 Set NoMod=$$CHKWMS^PRBS(MPRNr)
 Quit
 
UNLOCK(PRNr) 
 Lock -^PRBS("BS",PRNr),-^PRBS("BSS",PRNr)
 Quit
 
 ; Extra parameterkolom (Filler) voor kindproduct
Filler(sRec)
 New Filler
 Set Filler=$P(sRec,D,12)
 Set:$L($P(sRec,D,23)) Filler=Filler_" Inkort:"_$S($P(sRec,D,23):"ja",1:"neen")
 Set:$L($P(sRec,D,24)) Filler=Filler_" (#:"_$P(sRec,D,24)_")"
 Quit Filler
 		 
 ; Extra parameterkolom (Supplement) voor kost
Supplement(sRec)
 New X,Supplement
 Set X=$P(sRec,D,4)
 If 'X Set Supplement="faktor:"_$TR($J($P(sRec,D,5),0,3),".",",")_$C(59)_$S($P(sRec,D,6)="":"gans",1:$P(sRec,D,6))
 Else  If $L($P(sRec,D,9)) Set Supplement="Mat:"_$TR($J(X,0,2),".",",")_$C(59)_$P(sRec,D,9)
 Else  Set Supplement="suppl:"_$TR($J(X,0,3),".",",")
 Quit Supplement
  
SwitchNoSa(WithData)
 ;zw ^HULP(%J,"C") r k
 ; Opslaan huidige data voor switch
 ;If $G(sMod)&($G(WithData)||$D(^PRBS("BSS",MPRNr))) Do
 If $G(sMod) Do
 . Set Input="-"
 . Do ASKSAVE(.Input) ; past local Input aan
 . ;Write "input:",Input,"    ",!
 . Do SAVE(MPRNr,.DataNoSa):(Input="-")!(Input="SAVE")
 . Set Input=""
 . Set sMod=0
 ; Switch
 If CalcNoSa="S" Do ; Schaduw -> Normaal
 . Set CalcNoSa="N"
 . Set DataNoSa=""
 . If $D(^PRBS("BS",MPRNr)) Do 
 . . Do FETCH(MPRNr,DataNoSa)
 . . Set sMod=0
 Else  Do ; Normaal -> Schaduw
 . Set CalcNoSa="S"
 . If $G(WithData)="W" Do ; Rebuild from wizard
 . . Do RebuildBouwSteenFromWizard("S")
 . . Set DataNoSa="S"
 . . Do FETCH(MPRNr,DataNoSa)
 . . Set sMod=0
 . Else  If $D(WithData) Do
 . . Set DataNoSa="S"
 . . Set sMod=1 ; reeds gewijzigd
 . . ; geen fetch er wordt verdere gewerkt op de cache 
 . Else  If $D(^PRBS("BSS",MPRNr)) Do
 . . Set DataNoSa="S"
 . . Do FETCH(MPRNr,DataNoSa)
 . . Set sMod=0
 . Else  Do
 . . Set DataNoSa=""
 ;zw ^HULP(%J,"C") r k
 Quit
 
RebuildWizard
	Set DataNoSa="N",CalcNoSa="N"
	Do RebuildBouwSteenFromWizard("N")
	Do FETCH(MPRNr,DataNoSa)
 	Do REFRESH
	Quit
	
RebuildBouwSteenFromWizard(NoSa)
	Quit:'$P(^KPR(MPRNr,"G"),"\",13)
	Set GENTYP=$P($$GENTYP^HAD(MPRNr),"\")=""
	Quit:(GENTYP?1(1"KAD",1"TBX",1"GRP",1"TLM",1"ASM"))
	Quit:$D(^PRBS("BS",MPRNr))=""
	Quit:$G(NoSa)'="S"&&(GENTYP?1(1"KAD")) ; Kaderdeur is niet mogelijk bij normale prijs
	Set VersionIsFilled=($P(^PRBS("BS",MPRNr),"\",3)'="")
	Set:'VersionIsFilled $P(^PRBS("BS",MPRNr),"\",3)="v9.9.9" ; tijdelijk opzetten om de KPRCreate te kunnen uitvoeren
	If $G(NoSa)="S" Do
	. Do ##class(Prod.GAData.Product).KPRCreateSchaduwViaPRNr(MPRNr) ; Staffel wordt opgehaald uit de kenmerken	
	. Set:'VersionIsFilled $P(^PRBS("BS",MPRNr),"\",3)="" ; terug wissen
	Else  Do ; Normaal
	. Do ##class(Prod.GAData.Product).KPRModify(MPRNr,"H",0) ; Staffel wordt opgehaald uit de kenmerken		
	Quit
	 
ASKSAVE(Input)
 New OldInput  
 Set OldInp=Input
 ;past Input aan :
 ;  "-" voor exit met bewaar
 ;  "SAVE" voor tussentijds bewaar
 ;  "." exit zonder bewaar
 ;  "" geen exit
 If $D(^HULP(%J,"C"))'>1 Do  ; Gegevens verwijderen
 . ; Indien tussentijds Bewaar
 . If Input="SAVE" Set Input=$S((NoMod)!('sMod):"",1:$$^vhTXTPOP("PRBS","DELSAVE"))
 . ; Indien Sluit
 . If "\,\-\CANC\"[("\"_Input_"\") Set Input=$S((NoMod)!('sMod):".",1:$$^vhTXTPOP("FILE","DELSAVE"))
 Else  Do  ; Gegevens opslaan
 . ; Indien tussentijds Bewaar
 . If Input="SAVE" Set Input=$S((NoMod)!('sMod):"",1:"SAVE")
 . ; Indien Sluit
 . If "\,\-\CANC\"[("\"_Input_"\") Set Input=$S((NoMod)!('sMod):".",1:$$SAVE^vhINP(1,1))
 Quit
 
SAVE(PRNr,NoSa)  ; Opslaan van cache in ^PRBS en vervolgens in PRLINK en HADPR
 New %TC,R,Save,Next,KPRNr,Aantal,OrgVerp,MinStock,Ask,BSNode
 ;zw ^HULP(%J,"C") w !,"Nosa:",$G(NoSa),! r k
 
 Set sMod=0
 Set BSNode=$S($G(NoSa)="S":"BSS",1:"BS")
 Merge:$D(^PRBS(BSNode,PRNr)) ^PRBSH(BSNode,PRNr,$H)=^PRBS(BSNode,PRNr) ; Historiek bijhouden
 ; alleen verwijderen
 If $D(^HULP(%J,"C"))'>1 Do DELOBJ(PRNr,.NoSa) Quit
 ; verwijder oude data
 Do DELIND(PRNr,.NoSa)
 Do DELLNK(PRNr,.NoSa)
 Kill ^PRBS(BSNode,PRNr)
 ; opslaan nieuwe bouwstenen
 Set BSCode=""
 For  Set BSCode=$O(^HULP(%J,"C",BSCode)) Quit:BSCode=""  Do
 .Set Rec=^(BSCode)
 .If $P(Rec,D,3)="L" Do
 .. Do SAVELNK(PRNr,$P(Rec,D,1),$P(Rec,D,12),NoSa) ; link opslaan (recursief)
 . Else  Do
 .. Merge ^PRBS(BSNode,PRNr,BSCode)=^HULP(%J,"C",BSCode) ; bouwsteen opslaan, alsook de onderliggende dimensie
 ; opslaan hoofdnode
 Set:$D(^PRBS(BSNode,PRNr)) ^PRBS(BSNode,PRNr)=^HULP(%J,"C")
 ; aanpassing van LinkType in het producten bestand
 If ($P(^PRBS(BSNode,PRNr),"\")="MSK")&&($$$PRGet($$$LinkType)'="S") Do $$$PRSet($$$LinkType,"S")
 If ($P(^PRBS(BSNode,PRNr),"\")'="MSK")&&($$$PRGet($$$LinkType)="S") Do $$$PRSet($$$LinkType,"")
 ; opbouw indexen
 Do BLDIND(PRNr,.NoSa)
 ;Opslaan oude datastrukturen
 Do KPSAVE(PRNr,.NoSa) ; backwards comp : ^PRLINK
 Do HFSAVE(PRNr,.NoSa) ; backwards comp : ^HADPR("P",...
 Quit
 
SAVELNK(PRNr,LPRNr,Type)  ; Opslaan van link
 Quit:$G(NoSa)="S" 
 New TypPos,LPRNr2,TypPos2,Type2
 Quit:PRNr=LPRNr
 Quit:$D(^PRBS("LNK",PRNr,LPRNr)) ; Indien reeds bestaand dan geen verderzetting door recursie
 Set TypPos=$F("VAT",Type)
 Quit:TypPos<2 ; error
 Set ^PRBS("LNK",PRNr,LPRNr)=Type
 Do SAVELNK(LPRNr,PRNr,Type) ; omgekeerd
 Set LPRNr2=""
 For  Set LPRNr2=$O(^PRBS("LNK",LPRNr,LPRNr2)) Quit:LPRNr2=""  Do
 . Set Type2=^PRBS("LNK",LPRNr,LPRNr2)
 . Set TypPos2=$F("VAT",Type2)
 . Quit:TypPos2<2 ; error
 . Set Type2=$S(TypPos2>TypPos:Type,1:Type2) ; minimale linktype
 . Do SAVELNK(PRNr,LPRNr2,Type2) ; Recursie
 Quit
 
DELLNK(PRNr,NoSa) ; Verwijderen link
 Quit:$G(NoSa)="S"
 New LPRNr
 Set LPRNr=""
 For  Set LPRNr=$O(^PRBS("LNK",PRNr,LPRNr)) Quit:LPRNr=""  Do
 . Kill ^PRBS("LNK",PRNr,LPRNr)
 . Kill ^PRBS("LNK",LPRNr,PRNr)
 Quit
 
BLDIND(PRNr,NoSa) ; PRBS buildindex
 New BSKey,BSRec,KPRNr,BSNode,IPNode
 Set BSNode=$S($G(NoSa)="S":"BSS",1:"BS")	
 Set IPNode=$S($G(NoSa)="S":"IPS",1:"IP")	
 Set BSKey=""
 For  Set BSKey=$O(^PRBS(BSNode,PRNr,BSKey)) Quit:BSKey=""  Do
 . Set BSRec=^PRBS(BSNode,PRNr,BSKey)
 . Quit:($P(BSRec,D,3)'="K")&($P(BSRec,D,3)'="H")
 . Set KPRNr=$P(BSRec,D,1)
 . Quit:KPRNr'?4.7N
 . Set ^PRBS(IPNode,KPRNr,PRNr,BSKey)=$P(BSRec,D,3)
 Quit
 
DELIND(PRNr,NoSa) ; PRBS deleteindex
 New BSKey,BSRec,KPRNr,BSNode,IPNode
 Set BSNode=$S($G(NoSa)="S":"BSS",1:"BS")	
 Set IPNode=$S($G(NoSa)="S":"IPS",1:"IP")	
 Set BSKey=""
 For  Set BSKey=$O(^PRBS(BSNode,PRNr,BSKey)) Quit:BSKey=""  Do 
 . Set BSRec=^PRBS(BSNode,PRNr,BSKey)
 . Quit:($P(BSRec,D,3)'="K")&($P(BSRec,D,3)'="H")
 . Set KPRNr=$P(BSRec,D,1)
 . Quit:KPRNr'?4.7N
 . Kill ^PRBS(IPNode,KPRNr,PRNr,BSKey)
 Quit
 
KPSAVE(PRNr,NoSa) ; PRLINK save
 New R,KPRNr,Aantal,OrgVerp,BSRec,BSKey
 Quit:$G(NoSa)="S"
 Do KPDELIND(PRNr)
 Kill ^PRLINK("D",PRNr)
 Set BSKey=""
 For  Set BSKey=$O(^PRBS("BS",PRNr,BSKey)) Quit:BSKey=""  Do
 .Set BSRec=^PRBS("BS",PRNr,BSKey)
 .Quit:$P(BSRec,D,3)'="K" ; geen kindproduct
 .Set KPRNr=$P(BSRec,D),Aantal=$P(BSRec,D,2),OrgVerp=$P(BSRec,D,12)
 .Set R=Aantal_D_OrgVerp,^PRLINK("D",PRNr,KPRNr)=R
 Do KPBLDIND(PRNr)
 Quit
  
KPBLDIND(PRNr,NoSa) ; PRLINK buildindex
 Quit:$G(NoSa)="S"
 New KPRNr
 Set KPRNr=""
 For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:'KPRNr  Set ^PRLINK("IKM",KPRNr,PRNr)=""
 Quit
 ;
KPDELIND(PRNr,NoSa) ; PRLINK deleteindex
 Quit:$G(NoSa)="S"
 New KPRNr
 Set KPRNr=""
 For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:'KPRNr  Kill ^PRLINK("IKM",KPRNr,PRNr)
 Quit
 
HFSAVE(PRNr,NoSa) ; HADPR halffabrikaten save
 Quit ; Niet meer uitvoeren : PV 07/02/2010
 Quit:$G(NoSa)="S"
 New KPRNr,BSRec,BSKey,HFRec
 Kill ^HADPR("P",PRNr,"HF")
 Set BSKey=""
 For  Set BSKey=$O(^PRBS("BS",PRNr,BSKey)) Quit:BSKey=""  Do
 .Set BSRec=^PRBS("BS",PRNr,BSKey)
 .Quit:$P(BSRec,D,3)'="H" ; geen halffabrikaat
 .Set HFRec=""
 .Set $P(HFRec,D)=$P(BSRec,D) ; halfabrikaat product
 .Set $P(HFRec,D,2)=$P(BSRec,D,2) ; aantal
 .Set $P(HFRec,D,3)=$P(BSRec,D,14) ; werkvloer-submagazijn
 .Set $P(HFRec,D,4)=$P(BSRec,D,15) ; werklvoer-magazijn
 .Set ^HADPR("P",PRNr,"HF",BSKey)=HFRec
 .; eventueel ook dimensie record
 .Set:$D(^PRBS("BS",PRNr,BSKey,"D")) ^HADPR("P",PRNr,"HF",BSKey,"D")=^PRBS("BS",PRNr,BSKey,"D")
 Quit
 
BLDALL ; Heropbouwen van alle indexen en PRLINK
 Kill ^PRLINK
 Kill ^PRBS("IP")
 Set PRNr=""
 For  Set PRNr=$O(^PRLINK("D",PRNr))  Quit:PRNr=""  Do
 .Do BLDIND(PRNr)
 .Do KPSAVE(PRNr)
 Quit
 
DELOBJ(PRNr,NoSaLijst) ; Verwijderen bouwsteen (zonder locking)
 New NoSa,BSNode,I
 Set:$G(NoSaLijst)="" NoSaLijst="N;S"
 For I=1:1:$L(NoSaLijst,";") Do
 . Set NoSa=$P(NoSaLijst,";",I)
 . Set BSNode=$S($G(NoSa)="S":"BSS",1:"BS")
 . Do DELIND(PRNr,.NoSa)
 . Do KPDELIND(PRNr,.NoSa) ; PRLINK
 . Do DELLNK(PRNr,.NoSa) ; link tussen producten
 . Kill ^PRLINK("D",PRNr)
 . ;Kill ^HADPR("P",PRNr) ; niet meer gebruikt : PV 07/02/2010
 . Kill ^PRBS(BSNode,PRNr) ; bouwsteen
 . Kill ^PRBS("BP",PRNr) ; basisparameter
 . If ($$$PRGet($$$LinkType)="S") Do $$$PRSet($$$LinkType,"")
 Quit
 
COPYOBJ(FromPRNr,FromNoSa,ToPRNr,ToNoSa) ; copieren bouwstenen (zonder locking)
 New NoSa,ToBSNode,FromBSNode,BSCode,BSRec
 ; Defaulting
 Set:$G(ToPRNr)="" ToPRNr=FromPRNr
 Set:$G(ToNoSa)="" ToNoSa=$S($G(FromNoSa)="S":"N",1:"S")
 ; Verwijderen oude bouwstenen
 Do DELOBJ(ToPRNr,ToNoSa)
 ; copieren bouwstenen
 Set FromBSNode=$S($G(FromNoSa)="S":"BSS",1:"BS")
 Set ToBSNode=$S($G(ToNoSa)="S":"BSS",1:"BS")
 Set BSCode=""
 For  Set BSCode=$O(^PRBS(FromBSNode,FromPRNr,BSCode)) Quit:BSCode=""  Do
 .Set BSRec=^(BSCode)
 .If $P(BSRec,D,3)="L" Do
 .. Do SAVELNK(ToPRNr,$P(BSRec,D,1),$P(BSRec,D,12),ToNoSa) ; link opslaan (recursief)
 . Else  Do
 .. Merge ^PRBS(ToBSNode,ToPRNr,BSCode)=BSRec ; bouwsteen opslaan, alsook de onderliggende dimensie
 ; opslaan hoofdnode
 Set ^PRBS(ToBSNode,ToPRNr)=^PRBS(FromBSNode,FromPRNr)
 ; aanpassing van LinkType in het producten bestand
 If ($P(^PRBS(ToBSNode,ToPRNr),"\")="MSK")&&($$$ProductGet(ToPRNr,$$$LinkType)'="S") Do $$$ProductSet(ToPRNr,$$$LinkType,"S")
 If ($P(^PRBS(ToBSNode,ToPRNr),"\")'="MSK")&&($$$ProductGet(ToPRNr,$$$LinkType)="S") Do $$$ProductSet(ToPRNr,$$$LinkType,"")
 ; opbouw indexen
 Do BLDIND(ToPRNr,ToNoSa)
 ;Opslaan oude datastrukturen
 Do KPSAVE(ToPRNr,ToNoSa) ; backwards comp : ^PRLINK
 Do HFSAVE(ToPRNr,ToNoSa) ; backwards comp : ^HADPR("P",...
 
 Quit
 
PRINT(Output)
 Do
 . New List,Print
 . Do INIT^vhLISTO("PRBS","LIJST",.List)
 . Set List(10)="SCRNTYPVia^PRBS"
 . Set List(8)="Groep|Code|Type|Meerwaarde|Product/omschrijving|Aantal|Extra par.|Extra par.|Kost"
 . Do PRINT^OUTPUT(.List,Output,,"Bouwstenen "_MPRNr_".TXT")
 Do WRITE^vhLIST(.List)
 Quit
 
REFRESH 
 ;Do SYNCPR^HADWIZ(MPRNr) ; Syncronisatie van de tree
 Write @F11,@F1
 Do DISPLAY^vhScherm("PRBSHFD")
 Do WRITE^vhLIST(.List)
 Do UPDATE
 Quit
 ;
INIT 
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set MPRNr=$G(MPRNr,"*")
 Set sMod=0
 Do INIT^vhLIST("PRBS","LIJST",.List)
 Set List("UPTRAV")="X`S SortKey=$O(^HULP(%J,""S"",SortKey)) S sRec=$S(SortKey="""":"""",1:^HULP(%J,""S"",SortKey)) S:$L(sRec) $P(sRec,D,20)=$P(SortKey,"";"",3),$P(sRec,D,21)=$P($G(^HULP(%J,""V"",$P(sRec,D,20))),D,1)"
 Set List("UPTRAV")=List("UPTRAV")_",$P(sRec,D,30)=$P($G(^HULP(%J,""C"",$P(sRec,D,20),""D"")),D,1,3)"
 Set List("UPINIT")="X`D SORT^PRBS S SortKey="""""
 Set List("UPSEL")="@`BSSelect=$P(sRec,D,20)"
 ;          
 Do CALCC(.PrijsTree)
 Set NoMod=0
 Set BSSelect=""
 Set Input=""
 Quit
 ;
 ;
CHKWMS(PRNr,Type) 
 New Wms,ORDNr,OLUNr,TOENr,TLUNr
 Set Wms="",Type=$G(Type,"OR")
 If Type["O" Do
 .Set ORDNr=""
 .For  Set ORDNr=$O(^ORD("IP",PRNr,ORDNr)) Quit:ORDNr=""  Do  Quit:Wms["O"
 ..Set OLUNr=""
 ..For  Set OLUNr=$O(^ORD("IP",PRNr,ORDNr,OLUNr)) Quit:OLUNr=""  Do  Quit:Wms["O"
 ...Set:$D(^ORDW("IO",ORDNr,OLUNr)) Wms=Wms_"O"
 If Type["R" Do
 .Set TOENr=""
 .For  Set TOENr=$O(^TO("IP",PRNr,TOENr)) Quit:TOENr=""  Do  Quit:Wms["R"
 ..Set TLUNr=""
 ..For  Set TLUNr=$O(^TO("IP",PRNr,TOENr,TLUNr)) Quit:TLUNr=""  Do  Quit:Wms["R"
 ...Set:$D(^RCP("IT",TOENr,TLUNr)) Wms=Wms_"R"
 Quit Wms
 ;
 ; Bepaal het aantal kinderen van een moeder
AANTKIND(MPRNr) 
 New BSRec,AantKind,BSKey
 Set AantKind=0,BSKey=""
 For  Set BSKey=$O(^PRBS("BS",MPRNr,BSKey)) Quit:BSKey=""  Set BSRec=^PRBS("BS",MPRNr,BSKey) Set:$P(BSRec,D,3)="K" AantKind=AantKind+$P(BSRec,D,2)
 Quit AantKind
 
BouwSteenTypes(MPRNr)
 New BSRec,Types,BSKey
 Set Types="",BSKey=""
 For  Set BSKey=$O(^PRBS("BS",MPRNr,BSKey)) Quit:BSKey=""  Set BSRec=^PRBS("BS",MPRNr,BSKey) Set:Types'[$P(BSRec,D,3) Types=Types_$P(BSRec,D,3)
 Quit Types
 
Gewicht(MPRNr,InclVerpakProd)
 New BSRec,Gewicht,BSKey
 Set Gewicht="",BSKey=""
 For  Set BSKey=$O(^PRBS("BS",MPRNr,BSKey)) Quit:BSKey=""  Set Gewicht=Gewicht+$$GewichtBS(MPRNr,BSKey,.InclVerpakProd)
 Quit Gewicht
 
GewichtBS(MPRNr,BSKey,InclVerpakProd)
	; Gewicht in GR
	New KPRNr,Gewicht,DimHFNet,DimFull,Key,BSRec,Qty
	Set BSRec=^PRBS("BS",MPRNr,BSKey)
 	Set Qty=$P(BSRec,D,2)
	Set KPRNr=$P(BSRec,D,1)
	
 	If KPRNr?4.7N Do
	. If '$G(InclVerpakProd) Quit:$$IsVerpakking^PRODUKT2(KPRNr)
  	. Set Gewicht=$P($G(^KPR(KPRNr,1)),D,13)
 	. Quit:'Gewicht
	. If $D(^PRBS("BS",MPRNr,BSKey,"D")) Do  ;Dimensie afhankelijk
 	. . Set DimHFNet=$P(^PRBS("BS",MPRNr,BSKey,"D"),D,1)
 	. . Set DimFull=$P(^KPR(KPRNr,15),D,8) ; Bruto dimensie
 	. . Set:'DimFull DimFull=$P(^KPR(KPRNr,15),D,7) ; Netto dimensie
 	. . Set:DimFull&&DimHFNet Gewicht=Gewicht*DimHFNet/DimFull
 	. Set Gewicht=$J(Gewicht*Qty,0,2)
 	. ;Write BSKey," ","H"," ",Gewicht,!
 	Else  If $P(BSRec,D,3)="S"&&$L($P(BSRec,D,9)) Do
 	. Set Gewicht=""
 	. Set Key=$P(BSRec,D,9)
 	. &sql(SELECT Gewicht INTO :Gewicht FROM Prod_GAMeta_BT.KostMateriaal WHERE ItemID=:Key)
 	. Quit:Gewicht=""
 	. Set Gewicht=+$J(Gewicht*Qty*$P(BSRec,D,4),0,2)
 	. ;Write BSKey," ","S"," ",Gewicht,!
 	Quit $G(Gewicht) ;in gr
 	
SetLeverTermijn(MPRNr)
	New LeverTermijn,GenPRNr
	Set LeverTermijn=$$LeverTermijn(MPRNr)
	Set GenPRNr=$$$ProductGet(MPRNr,$$$GenProduct)
	Set:GenPRNr?4.7N LeverTermijn=LeverTermijn+$$$ProductGet(GenPRNr,$$$LeveringsTermijn)
	Do $$$ProductSet(MPRNr,$$$LeveringsTermijn,LeverTermijn)
	Quit
 
LeverTermijn(MPRNr,InclStock)
	New LeverTermijn,BSKey,LT
	Set LeverTermijn=0
	Set BSKey=""
	For  Set BSKey=$O(^PRBS("BS",MPRNr,BSKey)) Quit:BSKey=""  Do
	. Set LT=$$LeverTermijnBS(MPRNr,BSKey,.InclStock)
	. Set:LT>LeverTermijn LeverTermijn=LT
	Quit LeverTermijn
 
LeverTermijnBS(MPRNr,BSKey,InclStock)
	New BSRec,KPRNr,IsStock
	; De grootste levertermijn bepalen vn niet-stock producten.
	; Als het allemaal stockproducten zijn dan is het resultaat 0
	Set BSRec=^PRBS("BS",MPRNr,BSKey)
	Set KPRNr=$P(BSRec,D,1)
 	Quit:KPRNr'?4.7N 0
  	Quit:'$G(InclStock)&&$$$ProductGet(KPRNr,$$$StockType) 0
 	Quit $$$ProductGet(KPRNr,$$$LeveringsTermijn)
 	
 ; --- KOSTPRIJS BEREKENING ---
 
CALC(PRNr,Som,Interact,Debug,KLNr,NoSa)
 ; Om de verkoopprijs te bereken moet KLNr ingevuld zijn
 ; Indien KLNr ingevuld en resulterende $P(Som,D,1) = -1 dan is er fout bij de berekening
 ; Som piece 1 = Kost
 ;     piece 2 = Tijd
 ;     piece 3 = Tijd incl kleinverlet
 ;     piece 4 = Tijd incl klein en grootverlet
 ;     piece 5 = corr factor
 ;     piece 6 = welke type (K,H,T,S)van bouwstenen er voorkomen
 ;     piece 7 = ERROR
 New Error,BSNode,GlobRef
 Set GlobRef=$NA(^PRBS($S(($G(NoSa)="S")&&($D(^PRBS("BSS",PRNr))):"BSS",1:"BS"),PRNr))
 If '$$LOCKW^vhLock("NX",GlobRef) Do  Quit
 . Set $P(Som,D,7)="ERROR"
 Do CALCREF(.Som,GlobRef,$G(Interact),$G(Debug),$G(KLNr),$G(NoSa,"N"))
 Lock -@GlobRef
 
 Quit
 
CALCC(Som,Interact,Debug)
 ; Indien resulterende Som = -1 dan is er fout bij de berekening
 New Error
 Do CALCREF(.Som,$NA(^HULP(%J,"C")),$G(Interact),$G(Debug),$G(KLNr),$G(CalcNoSa,"N"))
 If $D(Error) Do WARN^vhTXTPOP("Fout bij het berekenen van de kostprijs")
 Quit
 
CALCREF(Som,Ref,Interact,Debug,KLNr,NoSa) 
 ; Som via .Local
 ; Ref verwijst naar cache of PRBS
 ; Indien Klantberekening en Som = -1 dan is er fout bij de berekening
 New Groep,SortNr,SortKey,BSKey,BSRec,BSType,Sort,BSCode,SomBeslag,SomKost,SomNoBeslag,GenPRNr,Aantal
 Set KLNr=$G(KLNr)
 Kill Som
 ; Ophalen van bouwstenen en sorteren volgens groep en sortvolgorder
 Set BSKey="" 
 For  Set BSKey=$O(@Ref@(BSKey)) Quit:BSKey=""  Do  ;Bouwstenen volgens Sorteervolgorde  Do
 . Set BSRec=@Ref@(BSKey)
 . Set SortNr=$P(BSRec,D,10)
 . Set Groep=$P(BSRec,D,11)
 . Set Groep=$S(Groep="":"*",1:Groep)
 . If $P(BSRec,D,3)="S",$L($P(BSRec,D,5)) Do
 .. Set SortNr=SortNr+1000 ; faktor berekening achteraan
 .. Set Groep=$P(BSRec,D,6) ; Groep waarop de faktor moet toegepast worden
 .. Set Groep=$S(Groep="":"~",1:Groep)
 . Merge Sort(Groep,1000+SortNr_";"_BSKey)=@Ref@(BSKey)
 
 Set (SomKost,SomBeslag,SomNoBeslag)=0
 If KLNr,Debug Do
 . Set GenPRNr=$P(^KPR(PRNr,0),D,3)
 . Set KortRec=$$GetKorting^KORTING(KLNr,GenPRNr,NoSa,,,,"DT")
 . Set Korting=$$OneKorting^KPRIJS($LI(KortRec,2),$LI(KortRec,3))
 
 ;Berekenen volgens sort
 Set (Groep,SortKey)=""
 For  Set Groep=$O(Sort(Groep)) Quit:Groep=""  Do
 . For  Set SortKey=$O(Sort(Groep,SortKey)) Quit:SortKey=""  Do
 .. Set BSRec=Sort(Groep,SortKey)
 .. Set BSType=$P(BSRec,D,3)
 .. Set Aantal=$P(BSRec,D,2)
 .. Set BSKey=$P(SortKey,";",2)
 .. If (BSType="K")!(BSType="H") Do CALCP ; Product
 .. If (BSType="S") Do CALCS ; Surplus
 .. If (BSType="T") Do CALCT ; Tijd
 .. Set:$P($G(Som),D,6)'[BSType $P(Som,D,6)=$P($G(Som),D,6)_BSType ;BouwSteenType
 Do:'KLNr PROMOTE(.Som)
 
 If KLNr Do
 . New PrijsGeg,GenPRNr,KortRec,Cif,DB,Korting
 . Set PrijsGeg=$$PRIJSGEG^KPRIJS(PRNr,NoSa)
 . Set Cif=$P(PrijsGeg,D,10)
 . Set DB=$P(PrijsGeg,D,12)
 . Set GenPRNr=$P(^KPR(PRNr,0),D,3)
 . Set KortRec=$$GetKorting^KORTING(KLNr,GenPRNr,NoSa,,,,"DT")
 . W:Debug !,$LI(KortRec,2)," ",$LI(KortRec,3)
 . Set Korting=$$OneKorting^KPRIJS($LI(KortRec,2),$LI(KortRec,3))
 . If Debug Do
 . . Write !,"Cif=",Cif," DB=",DB," Kort=",Korting,!
 . . Write !,"Som Beslag VKP=",SomBeslag
 . . Write !,"Som geen Beslag CifPPL=",SomNoBeslag,"-> VKP=",SomNoBeslag*(100+Cif/100)/(100-DB/100)*(100-Korting/100)
 . . Write !,"Som kost CifPPL=",SomKost,"-> VKP=",SomKost*(100+Cif/100)/(100-DB/100)*(100-Korting/100)
 . ;SomBeslag bevat reeds de verkoopprijs
 . ;SomNoBeslag en SomKost bevatten de kostprijs en moet omgezet worden naar verkoopprijs
 . Set Som=SomBeslag+(SomKost+SomNoBeslag*(100+Cif/100)/(100-DB/100)*(100-Korting/100))
 . Set Som=$J(Som,0,4)
 . Write:Debug !,"Som(verkoopprijs)=", Som
 
 If KLNr,$D(Error) Set Som=-1
 If 'KLNr,$D(Error) Set $P(Som,D,1)=-1
 Quit 
 
CALCP ; Bereken product prijs
 New KPRNr,Key,CifPPL,NetLen,HFLen,PrijsGeg
 Set KPRNr=$P(BSRec,D,1)
 If KPRNr'?4.7N Do  Quit
 . Set CifPPL=9999
 . Set Error(BSKey)="Product bestaat niet ingevuld"
 Set Key=$O(^KPR(KPRNr,"J"))
 If $E(Key)="J" Do
 . Set CifPPL=$P(^KPR(KPRNr,Key),D,23)
 . Set CorFakt=$P(^KPR(KPRNr,Key),D,8)
 . If NoSa="S" Set PrijsGeg=$$PRIJSGEG^KPRIJS(KPRNr,NoSa),CifPPL=$P(PrijsGeg,D,6),CorFakt=0 ;$P(PrijsGeg,D,20)
 Else  Do  Quit
 . Set CifPPL=9999
 . Set Error(BSKey)=KPRNr_": CifPPL bestaat niet"
 ;
 ; Halffab dimensie afhankelijk
 Set (HFLen,NetLen)=1
 If BSType="H",$D(Sort(Groep,SortKey,"D")) Do  ; Dimensie
 . Set NetLen=$P($G(^KPR(KPRNr,15)),D,7)
 . If NetLen'>0 Do  Quit  ; Controle Netto lengte
 .. Set Error(BSKey)=KPRNr_": Totale lengte niet ingevuld"
 .. Set NetLen=1 ; Om divide by zero te verhelpen
 . Set HFLen=$P(Sort(Groep,SortKey,"D"),D,3)
 . If HFLen'>0 Do  Quit  ; Controle Dimensie met uitval 
 .. Set Error(BSKey)=KPRNr_": Dimensie van HF niet ingevuld"
 Do:'KLNr&&(BSType="H") CALCADD($J(CorFakt*HFLen/NetLen,0,4)*Aantal,5) ; Correctie faktor alleen voor halffabr niet voor kindproducten
 Do:'KLNr CALCADD($J(CifPPL*HFLen/NetLen,0,4)*Aantal)
 Do:KLNr BerekenVKPvanBeslag(KLNr,KPRNr,NoSa,BSKey,CifPPL,Aantal,HFLen,NetLen)
 Quit
 
CALCT ; bereken verwerkingstijd
 New KV,GV,TijdP,TijdK,Kost,KPKey,KPRec
 Set KPKey=$P(BSRec,D,9) ; kostplaats code
 If KPKey="" Do  Quit
 . Set Error($P(BSKey,".",2))=$P(BSRec,D,13)_": Kostplaats niet ingevuld"
 Set oKostPlaats=##class(Prod.GAMeta.BT.KostPlaats).%OpenId(KPKey)
 If '$isObject(oKostPlaats) Do  Quit
 . Set Error(BSKey)=$P(BSRec,D,13)_": "_KPKey_" kostplaats onbekend"
 Set KV=oKostPlaats.GetToeslagKleinVerlet(.NoSa) 
 Set GV=oKostPlaats.GetToeslagGrootVerlet(.NoSa) 
 Set TijdP=$P(BSRec,D,7) ; Tijdplanning
 Set TijdK=$P(BSRec,D,8) ; Tijdkost
 Set Kost=TijdK*oKostPlaats.GetBasisKost(.NoSa)/3600 ; Tijd * kost
 Do:'KLNr CALCADD($J(Kost*KV*GV,0,4)*Aantal,1)
 Do:'KLNr CALCADD($J(TijdP,0,1)*Aantal,2)
 Do:'KLNr CALCADD($J(TijdP*KV,0,1)*Aantal,3)
 Do:'KLNr CALCADD($J(TijdP*KV*GV,0,1)*Aantal,4)
 Set:KLNr SomKost=SomKost+($J(Kost*KV*GV,0,4)*Aantal)
 Quit
 
CALCS ; bereken kost
 New Som2,Typ2,Grp2,Kost,oKostMat,KMKey
 If $P(BSRec,D,4) Do  ; Supplement
 . Set Kost=$P(BSRec,D,4)
 . Set KMKey=$P(BSRec,D,9)
 . Set:$L(KMKey) oKostMat=##class(Prod.GAMeta.BT.KostMateriaal).%OpenId(KMKey)
 . If $isObject($G(oKostMat)) Do
 . . Set Kost=+$J(oKostMat.MatKostCalc(Kost,.NoSa),0,4)
 . Set Kost=Kost*Aantal
 . Do:'KLNr CALCADD(Kost)
 . Set:KLNr SomKost=SomKost+Kost
 Else  If $P(BSRec,D,5) Do  ;VermenigvuldigingsFaktor
 . Set Som2=""
 . Set (Typ2,Grp2)=""
 . For  Set Typ2=$O(Som(Typ2)) Quit:Typ2=""  Do
 .. For  Set Grp2=$O(Som(Typ2,Grp2)) Quit:Grp2=""  Do
 ... If $P(BSRec,D,6)'="",Grp2'=Groep Quit  ; Als geen wildcard en groep is verschillend dan niet someren
 ... Set Som2=Som2+$P(Som(Typ2,Grp2),D,1)
 . ;Faktor toepassen
 . Set Kost=$J(Som2*$P(BSRec,D,5),0,4)*Aantal
 . Do:'KLNr CALCADD(Kost)
 . Set:KLNr SomKost=SomKost+Kost
 Quit
 
BerekenVKPvanBeslag(KLNr,PRNr,NoSa,BSCode,CifPPL,Aantal,HFLen,NetLen) ;Bereken van de verkoopprijs van het halffabrikaat als los product
 New HFPRNr,HFRec,HFRecD,HFPRNr,HFQty,Rec15,Prijs,DimHF,Prijs2,RecPrijs
 
 Write:Debug !,PRNr," ",$P(^KPR(PRNr,0),D),"  "
 If $P($T(GeenBeslag),";",2,99)[$P($G(BSCode),".") Do  ; Geen beslag producten
 . Set SomNoBeslag=SomNoBeslag+(CifPPL*HFLen/NetLen*Aantal)
 . Write:Debug "CifPPL:",CifPPL
 Else  Do  ; Beslag producten
 . Set RecPrijs=$$KlantPrijs^KPRIJS(KLNr,PRNr,NoSa,,,,"D")
 . Set Prijs=+$J($P(RecPrijs,D,14),0,4)
 . Set Prijs=Prijs*HFLen/NetLen
 . If Debug Do
 . . New LijstPr,Prijs2
 . . Set LijstPr=$P($$PRIJSGEG^KPRIJS(PRNr,NoSa),D,15)
 . . Set Prijs2=LijstPr*(100-Korting/100)
 . . Set Prijs2=$S($P(RecPrijs,D,3)="H":+$J(Prijs2+.0000499,0,4),1:+$J(Prijs2+.00499,0,2))
 . . Write " VKPLos:",+$J($P(RecPrijs,D,14),0,4)
 . . Write " ",$S(+$J($P(RecPrijs,D,14),0,4)'=+Prijs2:"?",1:"=")
 . . Write " VKPalsDeel:",Prijs2
 . . Write " VKPLen:",Prijs
 . Set SomBeslag=SomBeslag+(Prijs*Aantal)
 Quit
 
 // Bodems en verpakking behoren niet tot het beslag
GeenBeslag ;PRBDHO;PRBDHZ;PRRUGHS;PRVPCP;PRVPZW;PRVPOD;PRVULSTUK;PRRUGSP;PRBDHOSP
 
CALCADD(Value,Piece) 
 ; 1:Kost, 2:Tijd, 3:TijdKVerlet, 4:TijdGVerlet, 5:CorFaktor
 Set Piece=$G(Piece,1)
 Set $P(Som(BSType,Groep),D,Piece)=$P($G(Som(BSType,Groep)),D,Piece)+Value
 Set:Debug $P(Som(BSType,Groep,SortKey),D,Piece)=Value
 Set:Interact $P(^HULP(%J,"V",$P(SortKey,";",2)),D,Piece)=Value
 Quit
 
PROMOTE(Som) 
 New BSType,Groep,I,Rec
 Set (BSType,Groep)=""
 For I=1:1:5 Set $P(Som,D,I)=""
 For  Set BSType=$O(Som(BSType)) Quit:BSType=""  Do
 . Set Rec=""
 . For  Set Groep=$O(Som(BSType,Groep)) Quit:Groep=""  Do
 .. For I=1:1:5 Do
 ... Set $P(Rec,D,I)=$P(Rec,D,I)+$P(Som(BSType,Groep),D,I)
 ... Set $P(Som,D,I)=$P(Som,D,I)+$P(Som(BSType,Groep),D,I)
 . Set Som(BSType)=Rec
 Quit
 
 ; Wijzigen van het veld VERSIE (vrije tekst)
ModVersie
 New %SC
 Do FIELD^vhScherm("PRBSHFD","VERSIE")
 Set:%SC sMod=1
 Do REFRESH
 Quit
 
 ; Popup materiaalkost
MatKost(OldKost)
 New zb,MatKost 
 Do FetchMatKost(.MatKost)
 Set MatKost="MatKost",MatKost=$$WILD^vhPOPUP("C;C","-1KOZ","Materiaalkost",.MatKost,$G(OldKost))
 Quit MatKost 
  
 ; Toon popupelement materiaalkost (Optie zie vhScherm)
ShowMatKost(MatKost,Optie)
 Set MatKost=$G(MatKost),Optie=$G(Optie)
 Do:$L(MatKost)
 . Do FetchMatKost(.MatKost)
 . Set MatKost=MatKost(MatKost)
 . Set MatKost=$S(Optie="K":$P(MatKost,"`"),Optie="O":$P(MatKost,"`",2),1:$TR(MatKost,"`",":"))
 Quit MatKost 
  
 ; Fetch van de popupelementen materiaalkost
FetchMatKost(MatKost)
 
 &sql(DECLARE cMat CURSOR FOR SELECT ItemID,Omschrijving INTO :ItemID,Omschrijving FROM Prod_GAMeta_BT.KostMateriaal ORDER BY ItemID)
 &sql(OPEN cMat)
 For  &sql(FETCH cMat) Quit:(SQLCODE '= 0)  Set MatKost(ItemID)=ItemID_"`"_Omschrijving
 &sql(CLOSE cMat) 
 Quit
 
 ; Popup kostenplaats
KostPlaats(OldPlaats)
 New zb,KostPlaats
 Do FetchKostPlaats(.KostPlaats)
 Set KostPlaats="KostPlaats",KostPlaats=$$WILD^vhPOPUP("C;C","-1KOZ","Kostplaats",.KostPlaats,$G(OldPlaats))
 Quit KostPlaats 
  
 ; TRoon popupelement kostenplaats (Optie zie vhScherm)
ShowKostPlaats(KostPlaats,Optie)
 Set KostPlaats=$G(KostPlaats),Optie=$G(Optie)
 Do:$L(KostPlaats)
 . Do FetchKostPlaats(.KostPlaats)
 . Set KostPlaats=KostPlaats(KostPlaats)
 . Set KostPlaats=$S(KostPlaats="K":$P(KostPlaats,"`"),KostPlaats="O":$P(KostPlaats,"`",2),1:$TR(KostPlaats,"`",":"))
 Quit KostPlaats 
  
 ; Fetch van de popupelementen kostenplaats
FetchKostPlaats(KostPlaats)
 
 &sql(DECLARE cPlaats CURSOR FOR SELECT ItemID,Omschrijving INTO :ItemID,Omschrijving FROM Prod_GAMeta_BT.KostPlaats ORDER BY ItemID)
 &sql(OPEN cPlaats)
 For  &sql(FETCH cPlaats) Quit:(SQLCODE '= 0)  Set KostPlaats(ItemID)=ItemID_"`"_Omschrijving
 &sql(CLOSE cPlaats)
 
 Quit
 
 
CopyKarton(ToPRNr) 
 Do STORE^vhTERMINA()
 Set FromPRNr=$$SELECT^PRODUKT6(,,,"Verpakking copieren van : ")
 Do REFRESH^vhTERMINA()
 Quit:FromPRNr'?4.7N
 ;Write FromPRNr," ",$P(^KPR(FromPRNr,0),"\"),! r k
 If '##class(BL.Prod.OptiBox.Optimize).NbrOfOptiData("PR",FromPRNr) Do  Quit ; Heeft GEEN optibox data
 . Do WARN^vhTXTPOP("Product "_$P(^KPR(FromPRNr,0),D,1)_" heeft geen verpakking definities !")
 Do ##class(BL.Prod.OptiBox.BoxData).%New().Copy("PR",FromPRNr,"PR",ToPRNr)
 Quit
 
  ; berekening wat de kartonmachine kost aan tijd en materiaal (fanfold)
AutoKarton(PRNr)
	;Set PRNr=124919
	New Status,Result,BSKey,KindHalf,BSDefCod,Type,HFPRNr,Aantal,Lengte,Breedte,HistID,SnijMachineID,VolgNr,Rec,DimRec
	Set SnijMachineID=""
	#define OldAutoLabel "optibox"
	#define NewAutoLabel "optibox"
	Set Status=##class(BL.Prod.OptiBox.Diverse).CalcCarboardUse(PRNr,SnijMachineID,.Result)
	Quit:Status'="F"
	; Delete old values
	Set BSKey="" 
	For  Set BSKey=$O(^HULP(%J,"C",BSKey)) Quit:BSKey=""  Do
	. Kill:$P(^HULP(%J,"C",BSKey),D,11)=$$$OldAutoLabel ^HULP(%J,"C",BSKey)
	
	Set KindHalf=""
 	Set BSDefCod=""
 	For  Set BSDefCod=$O(^RES(BSPopGrp,"PI",BSPopNm,"D",BSDefCod)) Quit:BSDefCod=""  Do
 	. Set Type=$P(^RES(BSPopGrp,"PI",BSPopNm,"D",BSDefCod),"`",3)
 	. If Type?1(1"H",1"K") Set:KindHalf'="H" KindHalf=Type
	Set KindHalf="H"
 	 
	Set VolgNr=""
	For  Set VolgNr=$O(Result(VolgNr)) Quit:VolgNr=""  Do
	. Set Oms=$LG(Result(VolgNr),1)
	. Set HFPRNr=$LG(Result(VolgNr),2)
	. Set Aantal=$LG(Result(VolgNr),3)/$$GroepAantal(PRNr)
	. Set Lengte=$LG(Result(VolgNr),4)
	. Set Breedte=$LG(Result(VolgNr),5)
	. Set HistID=$LG(Result(VolgNr),6)
	. Set SnijMachineID=$LG(Result(VolgNr),7)
	. ; Materiaal
	. Set Rec=HFPRNr_D_Aantal_D_KindHalf
	. Set $P(Rec,D,10)=999 ; sortering achteraan
	. Set $P(Rec,D,11)=$$$NewAutoLabel
	. Set DimRec=(Lengte+.9\1)_D_(Lengte+.9\1)_D_(Lengte*1.05\1)
	. Set BSKey=$$DEFBSKEY^PRBS("VPK")
	. Set ^HULP(%J,"C",BSKey)=Rec
	. Set ^HULP(%J,"C",BSKey,"D")=DimRec
	. ; Tijd
	. Set KostPlaats=$S(SnijMachineID="HALUX":"HALUX KARTON",1:"OL KARTON")
	. Set Rec=D_Aantal_D_"T"
	. Set $P(Rec,D,10)=999 ; sortering achteraan
	. Set $P(Rec,D,11)=$$$NewAutoLabel
	. If $E(Oms,1,2)="OL" Do
	. . If (Oms["SEPARATOR")||(Oms["FILLER") Do
	. . . Set $P(Rec,D,7)=15 ; Tijd kost
	. . . Set $P(Rec,D,8)=15 ; Tijd werk
	. . Else  Do ; alle andere orgalux dozen
	. . . Set $P(Rec,D,7)=20 ; Tijd kost
	. . . Set $P(Rec,D,8)=20 ; Tijd werk
	. Else  Do
	. . Set $P(Rec,D,7)=30 ; Tijd kost
	. . Set $P(Rec,D,8)=30 ; Tijd werk
	. Set $P(Rec,D,9)=$S(SnijMachineID="HALUX":"HALUX KARTON",1:"OL KARTON") ; Kostenplaats
	. Set $P(Rec,D,13)="Snijden : "_Oms
	. Set BSKey=$$DEFBSKEY^PRBS("VPK")
	. Set ^HULP(%J,"C",BSKey)=Rec
	;zw ^HULP(%J,"C")
	Set sMod=1
	Do SORT^PRBS
	;zw ^HULP(%J,"S")
	Do UPDATE^PRBS
 	Quit
 	
GroepAantal(PRNr)
	Quit $S($$IsAntiSlipMat(PRNr):4,1:1)
	
IsAntiSlipMat(PRNr)
	{
		Set KortTekst=$$$PRGet($$$KortTekst)
		Quit ($E(KortTekst,1,5)="OL.AR") || ($E(KortTekst,1,5)="OL.AO") || ($E(KortTekst,1,5)="OL.AY")
	}
	
 ; verkorte ingave van de orgalux inpak 
 ; vertrekt van de bestaande gegevens indien ingevuld of probeert afhankelijk van de verpakking nieuwe te definieren.
AutoOrgalux(PRNr)
	;Set PRNr=124919
	New Status,Result,BSKey,KindHalf,BSDefCod,Type,HFPRNr,Aantal,Lengte,Breedte,HistID,SnijMachineID,VolgNr,Rec,DimRec
	
	#define LabelOld "VERPAK"
	#define OmsVouwenOld "Vouwen"
	#define OmsInpakOld "Inpakken"
	#define OmsAfwerkOld "Afwerken"
	#define OmsLuchtZakOld "Luchtzak"
	#define OmsToeslagOld "Toeslag oververpakking"
	
	#define LabelNew "VERPAK"
	#define OmsVouwenNew "Vouwen"
	#define OmsInpakNew "Inpakken"
	#define OmsAfwerkNew "Afwerken"
	#define OmsLuchtZakNew "Luchtzak"
	#define OmsToeslagNew "Toeslag oververpakking"
	
	; Get old values
	Set Values=""
	Set BSKey="" 
	For  Set BSKey=$O(^HULP(%J,"C",BSKey)) Quit:BSKey=""  Do
	. Set BSRec=^HULP(%J,"C",BSKey)
	. If ($P(BSRec,D,11)=$$$LabelOld)||($P(BSRec,D,11)=$$$LabelNew) Do
	. . If ($P(BSRec,D,13)=$$$OmsVouwenOld)||($P(BSRec,D,13)=$$$OmsVouwenNew) Set $P(Values,D,1)=$P(BSRec,D,7)
	. . If ($P(BSRec,D,13)=$$$OmsInpakOld)||($P(BSRec,D,13)=$$$OmsInpakNew) Set $P(Values,D,2)=$P(BSRec,D,7)
	. . If ($P(BSRec,D,13)=$$$OmsAfwerkOld)||($P(BSRec,D,13)=$$$OmsAfwerkNew) Set $P(Values,D,3)=$P(BSRec,D,7)
	. . If ($P(BSRec,D,13)=$$$OmsToeslagOld)||($P(BSRec,D,13)=$$$OmsToeslagNew) Set $P(Values,D,4)=$P(BSRec,D,5)
	. . If ($P(BSRec,D,13)=$$$OmsLuchtZakOld)||($P(BSRec,D,13)=$$$OmsLuchtZakNew) Set $P(Values,D,5)=$P(BSRec,D,2)
 
	Set Verpakking=$zobjclassmethod("BL.Prod.OptiBox.Diverse","OptiDataDisplayName",PRNr)
	
	If '$P(Values,D,1)&&'$P(Values,D,1)&&'$P(Values,D,1) Do ; Defaulting
	. Set $P(Values,D,4)=.05
	. If Verpakking["(Volume)" Do ; alleen volume
	. . Set $P(Values,D,1)=0
	. . Set $P(Values,D,2)=5
	. . Set $P(Values,D,3)=15
	. Else  If Verpakking[";" Do ; meerdere verpakkingen
	. . Set $P(Values,D,1)=15
	. . Set $P(Values,D,2)=30
	. . Set $P(Values,D,3)=15
	. Else  If Verpakking["/" Do ; combinatie
	. . Set $P(Values,D,1)=5
	. . Set $P(Values,D,2)=10
	. . Set $P(Values,D,3)=5
	. Else  Do ; single
	. . Set $P(Values,D,1)=10
	. . Set $P(Values,D,2)=20
	. . Set $P(Values,D,3)=15
 
	Set sFL(1)=Values
	Do NIEUW^vhScherm("PRBSOLAUTO",,,,,,1)
	Quit:'%SC
 
	Do AutoOrgaluxSet(PRNr,sFL(1))
	
	Quit
	
	; uitvoeren van de verkorte ingave
	; waar bij de oude gegevens worden verwijderd en de nieuwe worden ingevuld
AutoOrgaluxSet(PRNr,Values)
	
	; Delete old values
	Set BSKey="" 
	For  Set BSKey=$O(^HULP(%J,"C",BSKey)) Quit:BSKey=""  Do
	. Set BSRec=^HULP(%J,"C",BSKey)
	. If $P(BSRec,D,1)?4.7N,$E($P(^KPR(PRNr,0),D,1),1,3)="VPO" Kill ^HULP(%J,"C",BSKey)
	. Else  If ($P(BSRec,D,11)=$$$LabelOld)||($P(BSRec,D,11)=$$$LabelNew) Kill ^HULP(%J,"C",BSKey)
	
	; ToeslagMateriaal
	If $P(Values,D,4) Do
	. Set Rec=D_1_D_"S"
	. Set $P(Rec,D,11)=$$$LabelNew
	. Set $P(Rec,D,13)=$$$OmsToeslagNew
	. Set $P(Rec,D,5)=$P(Values,D,4)
	. Set BSKey=$$DEFBSKEY^PRBS("KOST")
	. Set ^HULP(%J,"C",BSKey)=Rec
	; Vouwen
	If $P(Values,D,1) Do
	. Set Rec=D_1_D_"T"
	. Set $P(Rec,D,11)=$$$LabelNew
	. Set $P(Rec,D,13)=$$$OmsVouwenNew
	. Set $P(Rec,D,7)=$P(Values,D,1)
	. Set $P(Rec,D,8)=$P(Values,D,1)
	. Set $P(Rec,D,9)="OLVERPAK"
	. Set BSKey=$$DEFBSKEY^PRBS("TIJD")
	. Set ^HULP(%J,"C",BSKey)=Rec
	; Inpak
	If $P(Values,D,2) Do
	. Set Rec=D_1_D_"T"
	. Set $P(Rec,D,11)=$$$LabelNew
	. Set $P(Rec,D,13)=$$$OmsInpakNew
	. Set $P(Rec,D,7)=$P(Values,D,2)
	. Set $P(Rec,D,8)=$P(Values,D,2)
	. Set $P(Rec,D,9)="OLVERPAK"
	. Set BSKey=$$DEFBSKEY^PRBS("TIJD")
	. Set ^HULP(%J,"C",BSKey)=Rec
	; Afwerken
	If $P(Values,D,3) Do
	. Set Rec=D_1_D_"T"
	. Set $P(Rec,D,11)=$$$LabelNew
	. Set $P(Rec,D,13)=$$$OmsAfwerkNew
	. Set $P(Rec,D,7)=$P(Values,D,3)
	. Set $P(Rec,D,8)=$P(Values,D,3)
	. Set $P(Rec,D,9)="OLVERPAK"
	. Set BSKey=$$DEFBSKEY^PRBS("TIJD")
	. Set ^HULP(%J,"C",BSKey)=Rec
	; ToeslagMateriaal
	If $P(Values,D,5) Do
	. Set Rec=D_1_D_"S"_D_"0.25"
	. Set $P(Rec,D,11)=$$$LabelNew
	. Set $P(Rec,D,13)=$$$OmsLuchtZakNew
	. Set $P(Rec,D,1)=$P(Values,D,5)
	. Set BSKey=$$DEFBSKEY^PRBS("KOST")
	. Set ^HULP(%J,"C",BSKey)=Rec
 
	;zw ^HULP(%J,"C")
	Set sMod=1
	Do SORT^PRBS
	;zw ^HULP(%J,"S")
	Do UPDATE^PRBS
 	Quit