#include Prod.Product
#include BL.Derde.LevSpecifiek
PRODUKT2 ;Produkt Indexen, Verwijderen [ 10/13/2003  4:53 PM ]
 d ^cA604 w $$CHECKDEL^PRODUKT2(3212,"U") q
CHECKDEL(PRNr,What) 
 New KLNr,ULNr,Lijn,PR,List,R,I,H,W,HoofdGr,Groep,SubGroep,Flow,FlowNr,MPRNr,KPRNr,Keys
 If '$L($G(What)) Set What="SHOFTPUZBKWM"   ; "E" is ook nog toegevoegd 
 ; Stock,Historiek,Orders,Toelevering,Pakket,Uitlevering,Z=Uitzondering,Bestelimpuls,Flow (Orders en uitlevering), K=Moeder-kind; W=WMS; E=Offerte; M=Master voor Auto-producten 
 Quit:'$D(^KPR(PRNr)) "Produkt bestaat niet"
 Set:$$$ProductGet(PRNr,$$$LinkType)="S" What=$TR(What,"S","") ; Moeder met stock over kinderen
 If What["S" Quit:$P(^KPR(PRNr,0),D,14) "Er is nog fysische stock : "_$P(^KPR(PRNr,0),D,14)_" stuk(s)"
 If What["H" Set H=$O(^KPR(PRNr,"H")) Quit:$E(H)="H" "Er zijn reeds historieken aanwezig"
 If What["H" Quit:$D(^PRHIST(PRNr)) "Er zijn reeds historieken aanwezig"
 If What["O",$D(^KPR(PRNr,"W")) Do  If $L(List) Quit "Er zijn nog order(s) : "_$E(List,2,49)
 .Set List="",W="W"
 .For  Set W=$O(^KPR(PRNr,W)) Quit:W=""!($E(W)'="W")  Set:$E(W,18,23)<200000 List=List_","_$E(W,18,23)
 If What["F" Do  If $L(List) Quit "Er zijn nog "_Flow_" : "_List
 .Set List=""
 .If $D(^ORD("IP",PRNr)) Do  Quit
 ..Set Flow="order(s)"
 ..Set FlowNr=""
 ..For  Set FlowNr=$O(^ORD("IP",PRNr,FlowNr)) Quit:'FlowNr  Set List=List_","_FlowNr
 ..Set List=$E(List,2,42)
 .If $D(^KUP(PRNr)) Do  Quit
 ..Set Flow="uitlevering(en)"
 ..Set FlowNr=""
 ..For  Set FlowNr=$O(^KUP(PRNr,FlowNr)) Quit:'FlowNr  Set List=List_","_FlowNr
 ..Set List=$E(List,2,42)
 If What["T",$D(^KPR(PRNr,"W")) Do  If $L(List) Quit "Er zijn nog toelevering(en) : "_$E(List,2,42)
 .Set List="",W="W"
 .For  Set W=$O(^KPR(PRNr,W)) Quit:W=""!($E(W)'="W")  Set:$E(W,18,23)>200000 List=List_","_$E(W,18,23)
 If What["P",$D(^PAKKET("IP",PRNr)) Do  If $L(List) Quit "Er zijn nog pakketten : "_$E(List,2,49)
 .Set (List,KLNr)=""
 .For  Set KLNr=$O(^PAKKET("IP",PRNr,KLNr)) Quit:KLNr=""  Set List=List_","_KLNr
 .;Set $E(List,1)="Dit produkt is vervat in pakket(ten) : "
 If What["U" Do  If $L(List) Quit "Er zijn nog uitlevering(en) : "_$E(List,2,42)
 .Set (List,ULNr)=""
 .For  Set ULNr=$O(^BON("IP",PRNr,ULNr)) Quit:ULNr=""  Do
 ..Set KLNr=$P($G(^KU1(ULNr,"F")),"\")
 ..Set:((KLNr'="")&&($D(^KUL(KLNr,"F",ULNr)))) List=List_","_ULNr
 If What["Z" Do  If $L(List) Quit "Er zijn nog uitzonderingen : "_$E(List,2,42)
 .Set List=""
 .set I=$O(^KPR(PRNr,"I")) Quit:$E(I)'="I"
 .Set R=^KPR(PRNr,I),HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3),KLNr=""
 .For  Set KLNr=$O(^KLPUTZ("IN",HoofdGr,Groep,SubGroep,PRNr,KLNr)) Quit:KLNr=""  Set List=List_","_KLNr
 If What["Z" Do  If $L(List) Quit "Er zijn nog schaduwuitzonderingen : "_$E(List,2,42)
 .Set List=""
 .set I=$O(^KPR(PRNr,"I")) Quit:$E(I)'="I"
 .Set R=^KPR(PRNr,I),HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3),KLNr=""
 .For  Set KLNr=$O(^KLPUTZ("IS",HoofdGr,Groep,SubGroep,PRNr,KLNr)) Quit:KLNr=""  Set List=List_","_KLNr
 If What["B" Do  If $L(List) Quit "Er zijn nog bestelimpulsen : "_$E(List,2,42)
 .Set List=""
 .Set KLNr=""
 .For  Set KLNr=$O(^KPBI("D",KLNr)) Quit:KLNr=""  Set:$D(^KPBI("D",KLNr,PRNr)) List=List_","_KLNr
 ;If What["K" Do  If $L(List) Quit "Dit is een moederprodukt van : "_$E(List,2,42)
 .Set List=""
 .Set KPRNr=""
 .For  Set KPRNr=$O(^PRLINK("D",PRNr,KPRNr)) Quit:KPRNr=""  Set List=List_","_KPRNr
 ; Kind van
 If What["K" Do  If $L(List) Quit "Dit is een kindprodukt van : "_$E(List,2,42)
 .Set List=""
 .Set MPRNr=""
 .For  Set MPRNr=$O(^PRBS("IP",PRNr,MPRNr)) Quit:MPRNr=""  Set List=List_","_MPRNr Quit:$L(List,",")>10
 ; WMS
 If What["W" Do  If $L(List) Quit "WMS in use in "_$E(List,2,42)
 . Set List=""
 . Set Keys=$$CheckProdInUse^EWPR(PRNr)
 . Quit:Keys=""
 . For I=1:1:$L(Keys) Set List=List_","_$S($E(Keys,I)="R":"Receptie",$E(Keys,I)="P":"Picking",1:"Stock")
 If What["W" Do  If $L(List) Quit "WMS in use in bon "_$E(List,2,42)  ; Kindproduct in ^ORDW
 . Set List=$$CheckWhatORDW(PRNr)
 If What["W" Do  If $L(List) Quit "WMS in use in receptie "_$E(List,2,42)  ; KindProduct in ^RCP
 . Set List=$$CheckWhatRCP(PRNr)
 If What["W" Do  If $L(List) Quit "WMS in use in terugname "_$E(List,2,42)  ; KindProduct in terugname
 . Set List=$$CheckWhatTN(PRNr)
 ; Offertes
 If What["E" Do  If $L(List) Quit "Er zijn nog offertes : "_$E(List,2,42)
 . Set List=""
 . Set FlowNr=""
 . For  Set FlowNr=$O(^KOFKLP(PRNr,FlowNr)) Quit:'FlowNr  Set List=$E(List,1,42)_","_FlowNr
 
 // ProductKenmerken : product is Master voor andere (Auto)-producten 
 Set List=""
 If What["M" {  
 	New ProductIDsVanAutoVarianten
 	Set ProductIDsVanAutoVarianten=##class(DOM.DomeinContext).Instance().GeefProductAPI().GeefProductMetKenmerken(PRNr).GeefProductIDsVanAutoVarianten()
 	If ProductIDsVanAutoVarianten.Count() {
 		Set List=ProductIDsVanAutoVarianten.Count()_" prod : "_##class(TECH.ListUtils).ListToPieces(ProductIDsVanAutoVarianten,", ")
 		Do ##class(vhLib.Logger).%New("APPS.PM.OL").Info("Verwijderen producten","Te verwijderen product ("_PRNr_") is MASTER voor "_List)
 	}
 }
 If $L(List) Quit "Is MASTER voor "_$S($L(List)>42:$E(List,1,39)_"...", 1:List)
 
 
 
 Quit ""
 
 ; Kindproduct in ^ORDW
CheckWhatORDW(KPRNr)
 New List,MPRNr,BSKey,ORDNr,OLUNr,CONSNr,SOLUNr
 Set List="",MPRNr=""
 For  Set MPRNr=$O(^PRBS("IP",KPRNr,MPRNr)) Quit:'MPRNr  Do
 . Set BSKey=""
 . For  Set BSKey=$O(^PRBS("IP",KPRNr,MPRNr,BSKey)) Quit:BSKey=""  Do
 . . Quit:^PRBS("IP",KPRNr,MPRNr,BSKey)'="K"
 . . Set ORDNr=""
 . . For  Set ORDNr=$O(^ORDW("IO",ORDNr)) Quit:ORDNr=""  Do
 . . . Set OLUNr=""
 . . . For  Set OLUNr=$O(^ORDW("IO",ORDNr,OLUNr)) Quit:OLUNr=""  Do
 . . . . Set CONSNr=^ORDW("IO",ORDNr,OLUNr)
 . . . . Quit:List[CONSNr
 . . . . Set SOLUNr=""
 . . . . For  Set SOLUNr=$O(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr)) Quit:SOLUNr=""  Do  Quit:List[CONSNr
 . . . . . Set:$P(^ORDW("D",CONSNr,"D",ORDNr,OLUNr,SOLUNr),D)=KPRNr List=List_","_CONSNr
 Quit List
 
 ; Kindproduct in ^RCP
CheckWhatRCP(KPRNr)
 New List,MPRNr,BSKey,TOENr,TLUNr,RCPNr,STLUNr
 Set List="",MPRNr=""
 For  Set MPRNr=$O(^PRBS("IP",KPRNr,MPRNr)) Quit:'MPRNr  Do
 . Set BSKey=""
 . For  Set BSKey=$O(^PRBS("IP",KPRNr,MPRNr,BSKey)) Quit:BSKey=""  Do
 . . Quit:^PRBS("IP",KPRNr,MPRNr,BSKey)'="K"
 . . Set TOENr=""
 . . For  Set TOENr=$O(^RCP("IT",TOENr)) Quit:TOENr=""  Do
 . . . Set TLUNr=""
 . . . For  Set TLUNr=$O(^RCP("IT",TOENr,TLUNr)) Quit:TLUNr=""  Do
 . . . . Set RCPNr=^RCP("IT",TOENr,TLUNr)
 . . . . Quit:List[RCPNr
 . . . . Set STLUNr=""
 . . . . For  Set STLUNr=$O(^RCP("D",RCPNr,"D",TOENr,TLUNr,STLUNr)) Quit:STLUNr=""  Do  Quit:List[RCPNr
 . . . . . Set:$P(^RCP("D",RCPNr,"D",TOENr,TLUNr,STLUNr),D)=KPRNr List=List_","_RCPNr
 Quit List
 
 ; Kindproduct in terugname
CheckWhatTN(KPRNr)
 New List,MPRNr,BSKey,CONSNr,BLUNr,RCPNr,SBLUNr
 Set List="",MPRNr=""
 For  Set MPRNr=$O(^PRBS("IP",KPRNr,MPRNr)) Quit:'MPRNr  Do
 . Set BSKey=""
 . For  Set BSKey=$O(^PRBS("IP",KPRNr,MPRNr,BSKey)) Quit:BSKey=""  Do
 . . Quit:^PRBS("IP",KPRNr,MPRNr,BSKey)'="K"
 . . Set CONSNr=""
 . . For  Set CONSNr=$O(^RCP("IU",CONSNr)) Quit:CONSNr=""  Do
 . . . Set RCPNr=^RCP("IU",CONSNr),BLUNr=""
 . . . For  Set BLUNr=$O(^RCP("D",RCPNr,"D",CONSNr,BLUNr)) Quit:BLUNr=""  Do  Quit:List[CONSNr
 . . . . Set SBLUNr=""
 . . . . For  Set SBLUNr=$O(^RCP("D",RCPNr,"D",CONSNr,BLUNr,SBLUNr)) Quit:SBLUNr=""  Do  Quit:List[CONSNr
 . . . . . Set:$P(^RCP("D",RCPNr,"D",CONSNr,BLUNr,SBLUNr),D)=KPRNr List=List_","_CONSNr
 Quit List
 
CheckDelAllList(PRNr,What)
  New Result,Status,I
  If '$L($G(What)) Set What="SHOTPUZBK"
  Set Result=""
  For I=1:1:$L(What) Do
  . Set Status=$$CHECKDEL(PRNr,$E(What,I))
  . Quit:Status=""
  . Set Result=Result_$LB(Status)
  Quit Result
  
CheckDelAllString(ProdKey,Separ,What)
	New Q,D,U,Result,Test,I,PRNr
	set Q="K",D="\",U=";"
	Set:$G(Separ)="" Separ=$C(10,13)
	Set:$G(Separ)=">CR<" Separ=$C(10)
	If ProdKey?4.7N Set PRNr=ProdKey
	Else  Set PRNr=$P($G(^KPR2($TR(ProdKey,".","")_" ")),D)
	Quit:PRNr="" "Identnr bestaat niet"
	Set Result=$$CheckDelAllList^PRODUKT2(PRNr,$G(What,"SOTPUZBK"))
	Quit:Result="" ""
	Set Test=""
	For I=1:1:$LL(Result) Set Test=Test_$S($L(Test):Separ,1:"")_$LI(Result,I)
	Quit Test
	
Gemaakt(ProductID)
 New EventData, Event, AdministratiefProduct
 Set EventData = ##class(DOM.PM.event.AdministratiefProductEventData).%New(ProductID)
 Set Event = ##class(DOM.PM.event.AdministratiefProductGemaaktEvent).%New(EventData)
 Do ##class(TECH.Context).Instance().GeefPubSubAPI().GeefEventRaiser().RaiseEventAsync(Event)
 Quit
 
Verwijderd(ProductID)
 New EventData, Event
 Set EventData = ##class(DOM.PM.event.AdministratiefProductEventData).%New(ProductID)
 Set Event = ##class(DOM.PM.event.AdministratiefProductVerwijderdEvent).%New(EventData)
 Do ##class(TECH.Context).Instance().GeefPubSubAPI().GeefEventRaiser().RaiseEventAsync(Event)
 
Gewijzigd(ProductID)
 New EventData, Event
 Set EventData = ##class(DOM.PM.event.AdministratiefProductEventData).%New(ProductID)
 Set Event = ##class(DOM.PM.event.AdministratiefProductGewijzigdEvent).%New(EventData)
 Do ##class(TECH.Context).Instance().GeefPubSubAPI().GeefEventRaiser().RaiseEventAsync(Event)
	
DELETE(PRNr,NoOld) 
 do ##class(DOM.PM.impl.DataM.DataMProductRepository).%New().VerwijderViaID(PRNr,'$get(NoOld))
 Quit
 
DELIND(PRNr,KortT,IdentNr,RecI,RecJ) ; Verwijderen indexen
 New blBldInd
 Set blBldInd=##class(BL.Prod.SearchBuildIndex).Instantiate()
 Do blBldInd.Init(PRNr) ; incl reload van het product object
 Do blBldInd.DeleteIndex()
 Quit
 
BLDIND(PRNr,KortT,IdentNr,RecI,RecJ) ; Opbouw indexen
 New blBldInd, AdministratiefProduct
 Set blBldInd=##class(BL.Prod.SearchBuildIndex).Instantiate()
 Do blBldInd.Init(PRNr) ; incl reload van het product object
 Do blBldInd.BuildIndex()
 Quit
 ;
REBLDIND(PRNr,KortT,IdentNr,RecI,RecJ) ; Heropbouw indexen
 Do DELIND(PRNr,.KortT,.IdentNr,.RecI,.RecJ)
 Do BLDIND(PRNr,.KortT,.IdentNr,.RecI,.RecJ)
 Quit
 ;
RECALC(PRNr,Rec) ; Herrekenen van de "J" node
 New C,P24,B,PR
 Set P24=1
 If '$D(Rec) S PR=$O(^KPR(PRNr,"J")) I $E(PR)="J" s Rec=^KPR(PRNr,PR)
 Set B(1)=Rec
 Set PR=PRNr
 New RLPP,RPLL,RVV
 Do ^KP0 
 Set ^KPR(PRNr,"J")="",^KPR(PRNr,"J"_+B(1))=B(1)
 ;Do UPDATE^LOG("PR",PRNr) ; Om zekere te zijn dat de VTW's de update krijgen
 Quit
 
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
 
 ; Nakijken of een korttekst geldig is
 ; Return : 1 = Geldig, 0 = Niet
CHECKKT(KortT,PRNr) 
 New K,Check,ExistKt
 If $L(KortT)<25 Set Check=$$ASK^vhWACHTW("MANAGER",2401,"",60*5) Quit:'Check Check
 Set Check=1
 Set ExistKt=$$EXISTKT(KortT,$G(PRNr))
 If ExistKt Do
 . Set Check=0
 . Do TXT^vhINP("Product "_KortT_" bestaat reeds")
 Else  Set:$TR($E(KortT,22,25)," ","")'="" Check=$$EXISTKK(KortT,1)
 Quit Check
 
 ; Nakijken of een korttekst reeds bestaat
 ; Return : 1 = Bestaat, 0 = Niet
 ; Indien PRNr is ingevuld dan mag de korttekst gelijk zijn voor dat produkt
EXISTKT(KortT,PRNr,IsGetPR) ; KortTekst MORE
 New VPR,Count,LenPR,RetPRNr
 Set Count=0
 Set KortT=$$UPTRIMAN^vhRtn1(KortT)
 Set VPR=$E(KortT,1,3)_" " Set:$L(VPR)>1 VPR=$O(^KPR1(VPR),-1) S LenPR=$L(KortT) S:LenPR>3 LenPR=3
 For  Set VPR=$O(^KPR1(VPR)) Quit:VPR=""!($E(VPR,1,LenPR)'=$E(KortT,1,LenPR))  If $$UPTRIMAN^vhRtn1($P(^(VPR),"\",2))=KortT,$G(PRNr)'=$P(^(VPR),"\") Set Count=Count+1,RetPRNr=$P(^(VPR),"\") Quit
 Quit:'$G(IsGetPR) Count
 Quit:Count=1 $G(RetPRNr) ;ipv aantal wordt het product nummer teruggegeven
 Quit ""
 
IDENTNR(Prompt,OldIDNr) 
 New IDNr
 Set OldIDNr=$G(OldIDNr)
 For  Set IDNr=$$ASK^vhINP(Prompt,11,OldIDNr,"","","","","","U") Quit:".-"[IDNr  Quit:$$CHECKID(IDNr)
 Quit IDNr
 
 ; Controleren dat een identnr een geldig formaat heeft
IsValidIdentNr(String)
 Quit ##class(DOM.PM.Product.impl.IdentNummerValidatorFactory).%New().GeefIdentNummerValidator(##class(DOM.AKP.enu.Leverancier).Blum()).IsGeldigIdentNummer(String, $$USERID^vhUSER())
 
 ; Nakijken of een identnummer geldig is (Dit is een oude controle, waarschijnlijk niet meer gebruikt CW 15.02.11)
 ; Return : 1 = Geldig, 0 = Niet
CHECKID(IDNr) 
 New K,Value,Check,ExistId
 If IDNr'?1N1"."3N1"."3N1"."1N Quit 0
 Set Value=($E(IDNr,3)*6)+($E(IDNr,4)*5)+($E(IDNr,5)*4)+($E(IDNr,7)*3)+($E(IDNr,8)*2)#11
 If Value'>1 Set Check=$S(Value=0:1,1:0),Check=$E(IDNr,9)=Check
 Else  Do
 .Set Check=11-Value
 .If 810[$E(IDNr),Check'=$E(IDNr,9) Set Check=11+1-Value Set:Value+1'<11 Check=0
 .Set Check=$E(Check,$L(Check)),Check=Check=$E(IDNr,9)
 
 If 'Check Do  ; Controle tweede wijze voor onderdelen, promotieartikelen en catalogen
 .Set Value=$E(IDNr,3)*1+($E(IDNr,4)*3)+($E(IDNr,5)*1)+($E(IDNr,7)*3)+($E(IDNr,8)*1)+($E(IDNr,9)*3)#10
 .Set Check=10-Value
 .Set Check=$E(IDNr,11)=Check
 Set ExistId=$$EXISTID(IDNr)
 If ExistId Set Check=0 Xecute ^cTXT(0,"N",12) Read K
 Quit Check
 
 ; Nakijken of een identnummer reeds bestaat
 ; Return : 1 = Bestaat, 0 = Niet
EXISTID(IDNr) 
 Set IDNr=$$UPTRIMAN^vhRtn1(IDNr)_" "
 Quit $D(^KPR2(IDNr))
 
 ; Nakijken of een kleurenkode reeds bestaat en eventueel openen
 ; Return : 1 = Bestaat, 0 = Niet
EXISTKK(Kode,IsKortT) ; Kleurkode
 New Exist
 Set Exist=0
 If $G(IsKortT) Set Kode=$E(Kode,22,25)
 If '$D(^KCOL(Kode_" ")) Do
 .Set R=$S($G(GenPRNr)=36945:"N",$G(GenPRNr)=64421:"N",$G(GenPRNr)=73220:"N",1:$$^vhTXTPOP("PRODUKT2","EXISTKK","","ŞB"_$TR(Kode," ","")_"Şb"))
 .Do:R="O" LEXTERN^PRKLEUR(Kode)
 .Set:R="N" Exist=1
 Set:'Exist Exist=$D(^KCOL(Kode_" "))
 Quit Exist
 
 ; Fetch produktgegevens in B of opgegeven local
FETCHPR(PRNr,Local) 
 New Inc,Key Set Inc=0
 Set:'$D(Local) Local="B",Inc=1
 Kill @Local
 Quit:'$D(^KPR(PRNr))  Set I1=PRNr
 For I=0:1:5 Set @Local@(I+Inc)=^KPR(I1,I)
 For I="I","J" Set @Local@(I)="",Key=$O(^KPR(I1,I)) Set:$E(Key)=I @Local@(I)=^KPR(I1,Key)
 Quit
 
 ; Save produktgegevens vanuit B of opgegeven local
SAVEPR(PRNr,Local) 
 New Inc,Key Set Inc=0
 Set:'$D(Local) Local="B",Inc=1
 Set I1=PRNr
 For I=0:1:5 Set ^KPR(I1,I)=@Local@(I+Inc)
 For I="I","J" If $L(@Local@(I)) Do
 .Set Key=$O(^KPR(I1,I))
 .If $E(Key)'="I" Set Key=$S(I="I":"I1",1:"J"_$P(@Local@(I),D))
 .Set ^KPR(I1,Key)=@Local@(I)
 Quit
INPBREF(Local)
 New Inc,Key Set Inc=0
 Set:'$D(Local) Local="B",Inc=1
 Set Key=""
 For I=4+Inc:1:5+Inc For J=1:1:3 Set Key=Key_I_U_J_D
 For I=4+Inc:1:5+Inc For J=4:1:10 Set Key=Key_I_U_J_D
 Do STORE^vhTERMINA()
 Set FP=1701
 Write @F,@F1,!,$P(U2,U)," :"
 Do MULTI^vhBIGEDIT("19;1;24;45",Local,Key,"I","B")
 Do REFRESH^vhTERMINA()
 Set K=$P(@Local@(4+Inc),D,1)
 If zb=-2 Quit
 Set FP=$P(U2,U,5)*100+$P(U2,U,6),J=$P(U2,U,9)+$P(U2,U,13)
 For I=1:1:5 Do
 .Set FP=FP+100 Write @F,$J("",J),@F
 .Write $P(@Local@(I\3+4+Inc),D,I#3+1)
 Quit
 
MOREBREF 
 New I
 For I=504:1:510,604:1:610 Quit:$L($P($G(B(I\100)),D,I#100))
 If $L($P($G(B(I\100)),D,I#100)) Set FP=FP+200 Write @F,"..." Set FP=FP-200
 Quit
 
INPLTEXT(Taal,Local,DispL) 
 New Inc,Key
 Set Inc=$F("N;F;D;E",Taal)-1
 Set:$D(Local) Inc=Inc-1 Set:'$D(Local) Local="B"
 If Taal="N" Set Key=Inc_";2\"_Inc_";11\"
 Else  If Taal="F" Set Key=(Inc-1)_";22\"_(Inc+1)_";21\"
 Else  If Taal="D" Set Key=(Inc-2)_";2\"_(Inc-1)_";23\"
 Else  Set Key=(Inc-4)_";1\"_(Inc-3)_";22\"
 For I=6+Inc:1:7+Inc Set:'$D(@Local@(I)) @Local@(I)="" For J=1:1:10 Set Key=Key_I_U_J_D
 Do STORE^vhTERMINA()
 Set FP=1701
 Write @F,@F1,!,$P(U2,U)," :"
 Do MULTI^vhBIGEDIT("19;1;24;45",Local,Key,"I","B","26;44")
 Do REFRESH^vhTERMINA()
 Set K=$P(@Local@(+Key),D,$P($P(Key,"\"),";",2))
 If zb=-2 Quit
 Set FP=$P(U2,U,5)-1*100+$P(U2,U,6)
 For I=1:1:$G(DispL,2) Do
 .Set FP=FP+100 Write @F,$J("",$S(I=1:26,1:44)),@F
 .Write $P(@Local@($P($P(Key,"\",I),";")),D,$P($P(Key,"\",I),";",2))
 Quit
 
TAALTEXT(Taal) 
 New B,I,R
 For I=0:1:$O(^KPR(PR,20),-1)  Set B(I+1)=$G(^KPR(PR,I))
 Do INPLTEXT(Taal,,3)
 For I=1:1:$O(B(""),-1)  Set ^KPR(PR,I-1)=$G(B(I))
 Do KLEUR^KPE31
 Quit
 
GETOMSCH(PRNr,Taal) 
 New B,I,J,Inc,Key,Omschr
 Set Taal=$G(Taal,"N"),Inc=$F("N;F;D;E",Taal)-1
 Set Key=$S(Taal="N":"1;2\1;11\",Taal="F":"2;22\4;21\",Taal="D":"3;2\4;23\",1:"3;1\4;22\")
 For I=0:1:$O(^KPR(PRNr,20),-1) Set B(I+1)=$G(^KPR(PRNr,I))
 For I=6+Inc:1:7+Inc For J=1:1:10 Set Key=Key_I_U_J_D
 Set Omschr=""
 For I=1:1:$L(Key,D) If $L($P(Key,D,I)) Set Omschr=Omschr_D_$P($G(B($P($P(Key,D,I),";"))),D,$P($P(Key,D,I),";",2))
 Set $E(Omschr)=""
 Quit Omschr
 
GETROUND(PRNr,Munt) 
 New R,GrOrde,KKey
 Set GrOrde=""
 Set R=$O(^KPR(PRNr,"I")) Set:$E(R)="I" R=^KPR(PRNr,R)
 Set KKey=$P(R,D,4)
 Set:KKey R=^KLAS("K",KKey),GrOrde=$P(R,D,14)
 Set:GrOrde="" GrOrde="E"
 Quit GrOrde
 
GRORDEOld(PRNr,NoSa) 
 New R,GrOrde,KKey
 Set GrOrde=""
 Set R=$O(^KPR(PRNr,"I")) Set:$E(R)="I" R=^KPR(PRNr,R)
 Set KKey=$P(R,D,4)
 If KKey Do
 .Set R=^KLAS("K",KKey),GrOrde=$P(R,D,$S($G(NoSa)="S":15,1:14))
 .If $G(NoSa)="S",GrOrde="" Set GrOrde=$P(R,D,14)
 Set:GrOrde="" GrOrde="E"
 Quit GrOrde
 
 ; Niveau "P" = product
 ; Niveau "S" = subgroep
GRORDE(PRNr,NoSa,Niveau) 
 New R,GrOrde,KKey
 Set Niveau=$G(Niveau,"P"),GrOrde=""
 Set:Niveau="P" R=^KPR(PRNr,1),GrOrde=$E($P(R,"\",$S($G(NoSa)="S":14,1:10)))
 Do:GrOrde=""
 .Set R=$O(^KPR(PRNr,"I")) Set:$E(R)="I" R=^KPR(PRNr,R)
 .Set KKey=$P(R,"\",4)
 .If KKey Do
 ..Set R=^KLAS("K",KKey),GrOrde=$P(R,"\",$S($G(NoSa)="S":15,1:14))
 ..If $G(NoSa)="S",GrOrde="" Set GrOrde=$P(R,"\",14)
 .Set:GrOrde="" GrOrde="E"
 Quit GrOrde
 
 ; volgende korttekst voor afdekkappen
NEXTABD(PRNr,AutoOp) 
 New R,OKortTxt,OKortCmp,NKortTxt,NKortCmp,Prev,Next,KLNr,Tabel,Kleur
 Set AutoOp=$G(AutoOp) ; enkel links of rechts opzoeken
 Set Tabel(" 80D6107")=""
 Set Tabel(" 90D2103")=""
 Set Tabel(" 90D2203")=""
 Set Tabel(" 94D3203")=""
 Set Tabel("ZAAD230N")=""
 Set Tabel("ZAAD300N")=""
 Set Tabel("ZAAD3500")=""
 Quit:'$D(^KPR(PRNr,"J5529")) ""
 Set OKortTxt=$P(^KPR(PRNr,0),D),Kleur=$E(OKortTxt,22,25)
 Quit:$E(OKortTxt,12,14)'="ABD" ""
 Quit:'$D(Tabel($E(OKortTxt,1,8))) ""
 Set OKortCmp=$$COMPR^PRODUKT(PRNr)
 If $E(OKortTxt,20,21)="*L" Do  Quit:$E(NKortTxt,20,21)="*R" NKortTxt
 .Set KLNr=$E(OKortTxt,16,19),R="ABD"_KLNr,NKortCmp=$P(OKortCmp,R)_R
 .Set R=$P(OKortCmp,R,2),$E(R)="R",NKortCmp=NKortCmp_R
 .Set NKortTxt=""
 .Quit:$D(^KPR1(NKortCmp))
 .Set NKortTxt=OKortTxt,$E(NKortTxt,20,21)="*R"
 If $E(OKortTxt,20,21)="*R" Do  Quit:$E(NKortTxt,20,21)="*L" NKortTxt
 .Set KLNr=$E(OKortTxt,16,19),R="ABD"_KLNr,NKortCmp=$P(OKortCmp,R)_R
 .Set R=$P(OKortCmp,R,2),$E(R)="L",NKortCmp=NKortCmp_R
 .Set NKortTxt=""
 .Quit:$D(^KPR1(NKortCmp))
 .Set NKortTxt=OKortTxt,$E(NKortTxt,20,21)="*L"
 Quit:AutoOp "-"
 Set R=$E(OKortTxt,5,8),R=$P(OKortCmp,R)_R_"~"
 Set Prev=$O(^KPR1(R),-1)
 Quit:Prev="" ""
 Set PRNr=$P(^KPR1(Prev),D),NKortTxt=$P(^KPR(PRNr,0),D)
 Quit:$E(NKortTxt,1,8)'=$E(OKortTxt,1,8) ""
 Set Next=$E(NKortTxt,9,11),Next=$$NEXTALFA(Next),$E(NKortTxt,9,11)=Next Set:$L(Kleur) $E(NKortTxt,22,25)=Kleur
 Set R=NKortTxt,$E(R,16,19)="    ",FP=2001
 Write @F,@F1,$E(R,1,15),@FMTB,"????",@FMTb,$E(R,20,99)
 Set KLNr=$$SELECT^KLANT6(1,"")
 Quit:'KLNr "-"
 Set $E(NKortTxt,16,19)=KLNr,FP=2001
 Write @F,@F1
 Quit NKortTxt
 ;
NEXTALFA(Next) 
 New Char1,Char2,Char3
 Set Next=$TR($J(Next,3)," ",0),Char1=$A($E(Next)),Char2=$A($E(Next,2)),Char3=$A($E(Next,3))
 Set Char3=Char3+1
 If Char3>57,Char3<65 Set Char3=65
 If Char3>90 Do
 .Set Char3=48,Char2=Char2+1
 .If Char2>57,Char2<65 Set Char2=65
 .If Char2>90 Do
 ..Set Char2=48,Char1=Char1+1
 ..If Char1>57,Char1<65 Set Char1=65
 Set Next=$C(Char1)_$C(Char2)_$C(Char3)
 Quit Next
 ;
 ; Volgend dossiernummer
NextDossier(Node)
 Quit ##class(DOM.PM.Maatwerk.ProductUtils).GeefVolgendeDossierCode(Node)
 ;
 ; Dossierreferentie
DossierRef(PRNr)
 New DossierRef,GenPRNr
 Set GenPRNr=$P($G(^KPR(PRNr,0)),D,3)
 Do:$L(GenPRNr)
 . If 'GenPRNr Set DossierRef=$P($G(^KPR(PRNr,"G")),D,4)
 . Else  Set DossierRef=$$DossierRef(GenPRNr)
 Quit $G(DossierRef)
 ;
SHOWKT(K,B) 
 New GenProd
 Set GenProd=$P($G(B(1)),D,3),GenProd=$S(GenProd="":"",GenProd?4.7N:"Afgeleid",1:"Generisch")
 Quit K_$J("",45-$L(K)-$L(GenProd))_GenProd
 ;
LINKTYPE 
 New zb,LinkType,Exit
 For  Do  Quit:Exit
 .Set Exit=1,K=$P(B(1),D,23),LinkType=$$LINKTYPE^PRLINK(K)
 .If LinkType="S",'$D(^PRLINK("D",PR)) Set Exit=0 Quit
 .Set:zb'="CANC" K=LinkType
 Quit
 ;
OPSLZONE(PRNr) 
 New OpslZone
 Set OpslZone=""
 If $G(PRNr) Set OpslZone=$P($G(^KPR(PRNr,2)),D,15)
 Quit OpslZone
 ;
 ; Opslagzone manueel
OPSLMAN(PRNr) 
 New OpslMan,OpslZone
 Set OpslMan=0
 Do:$G(PRNr)
 .Set OpslZone=$$OPSLZONE(PRNr)
 .If OpslZone'=0,OpslZone'=9
 .Else  Set OpslMan=1
 Quit OpslMan
 ;
 ; Met of zonder magazijn handeling
MAGHANDEL(PRNr) 
 New MagHandel,OpslZone
 Set MagHandel=0
 Set:$G(PRNr) MagHandel=$$OPSLZONE(PRNr)'=22
 Quit MagHandel
 ;
 ; Ophalen leverancier
LEVNR(PRNr) 
 New R,LEVNr
 Set LEVNr=""
 If $L($G(PRNr)),$D(^KPR(PRNr)) Do
 .Set R=$O(^KPR(PRNr,"J"))
 .Quit:$E(R)'="J"
 .Set R=^KPR(PRNr,R),LEVNr=$P(R,"\")
 Quit LEVNr
 
 // Opvragen en Wijzigen productleverancier 
LeverancierChange(PRNr,LEVNr) 
 New Ask,OudeLEVNr
 Write @F11,@F1,@FMTI," Wijzigen productleverancier ",QN," ",@FMTi
 If $G(PRNr)'?1.7N Set PRNr=$$SELECT^PRODUKT6()
 Quit:'PRNr
 Set FP=301 Write @F,"Product : ",$P(^KPR(PRNr,0),D)
 Set OudeLEVNr=$E($O(^KPR(PRNr,"J")),2,99)
 Set FP=501 Write @F,"Van leverancier : ",OudeLEVNr," ",$P(^DLE("K","LE.A",OudeLEVNr,0),D,2)
 If $G(LEVNr)'?1.5N Set LEVNr=$$SELECT^LEVER(1)
 Quit:'LEVNr
 Quit:'$D(^DLE("K","LE.A",LEVNr))
 Set FP=701 Write @F,"Naar Leverancier : ",LEVNr," ",$P(^DLE("K","LE.A",LEVNr,0),D,2)
 Set Ask=$$^vhTXTPOP("PRODUKT","WIJZIGLEV")
 Quit:'Ask
 Do LEVCHANG(PRNr,LEVNr)
 Quit
 
 // Wijzigen productleverancier
LEVCHANG(PRNr,LEVNr) ;
 New LEVNrOld,KeyOld,Rec
 Quit:'$D(^DLE("K","LE.A",LEVNr))
 Set KeyOld=$O(^KPR(PRNr,"J"))
 Quit:$E(KeyOld)'="J"
 Set LEVNrOld=$E(KeyOld,2,99)
 Quit:LEVNrOld=LEVNr
 Lock +^KPR(PRNr) 
 Else  Set Ask=$$WARN^vhLock($NA(^KPR(PRNr)),"X") Quit
 Do DELIND^PRODUKT2(PRNr)
 Set Rec=^KPR(PRNr,KeyOld)
 Set Key="J"_LEVNr
 Set $P(Rec,D)=LEVNr
 Set ^KPR(PRNr,Key)=Rec
 Kill ^KPR(PRNr,KeyOld)
 Do BLDIND^PRODUKT2(PRNr)
 Lock -^KPR(PRNr)
 Quit
 
IsVerpakking(PRNr) ; heeft niets te maken met RecuPak
	Quit ($P($G(^KPR(PRNr,1),90),"\")=90)  ; 90 of 91 = Verpakkingsproduct (zie PRODUKT;STOCKAGEGRP)
 
 ; TA=Tandem, AV=Aventos
Is(PRNr,Type) 
	Quit:Type="TA" $$IsTandem(PRNr)
	Quit:Type="AV" $$IsAventos(PRNr)
	Quit:Type="SDM" $$IsSDM(PRNr) ; servodrive op maat
	Quit 0
	
 ; Is Halux produkt
ISHALUX(PRNr) 
 Quit $$LEVNR($G(PRNr))=6332
 ;
 ; Is Blum produkt
ISBLUM(PRNr) 
 Quit $$LEVNR($G(PRNr))=5005
 ;
 ; Is Van Hoecke produkt
ISNV(PRNr) 
 Quit $$LEVNR($G(PRNr))=6051
 ;
 ; Is Orgalux produkt
ISORGAL(PRNr,CheckOld)
 new IsOrgalux, I
 Set IsOrgalux = 0
 If (##class(DOM.DomeinContext).Instance().GeefProductAPI().BestaatProduct(PRNr))
 {
	Set IsOrgalux = ##class(DOM.DomeinContext).Instance().GeefProductTypeAPI().IsOrgaluxProduct(PRNr)
 }
 ElseIf $G(CheckOld)
 {
	Set I=$O(^KPRO(PRNr,"I")) 
 	Set:$E(I)="I" R=^KPRO(PRNr,I)
 	Set IsOrgalux = ($E($G(R),3,4)="OL")
 }
 Quit IsOrgalux
 ;
 ; Is het orgalux product een product op maat?
IsOrgaluxOpMaat(PRNr)
	new ProductClassificatie
	Set ProductClassificatie = ##class(DOM.DomeinContext).Instance().GeefProductRolAPI().GeefAdministratiefProduct(PRNr).GeefClassificatieKnoop()
	Quit ((ProductClassificatie.GeefID() = ##class(DOM.PM.enu.Classificatie).OrgaluxOpMaat()) || (ProductClassificatie.GeefID() = ##class(DOM.PM.enu.Classificatie).InlegmattenIngekort()))
	
IsTaorCubicover(PRNr)
	new ProductClassificatie
	Set ProductClassificatie = ##class(DOM.DomeinContext).Instance().GeefProductRolAPI().GeefAdministratiefProduct(PRNr).GeefClassificatieKnoop()
	Quit (ProductClassificatie.GeefID() = ##class(DOM.PM.enu.Classificatie).TAORCUBICOVERInzet())

 ; Geeft TRUE voor het moeder-product; Voor de kind-producten (zijnde LBX of andere lades) geeft deze False terug. 
IsSpaceTower(PRNr)
	Quit ##class(DOM.DomeinContext).Instance().GeefProductTypeAPI().IsSpaceTowerProduct(PRNr)


 ;
 ; Is tandembox
ISTBX(PRNr) 
 New Is
 Set Is=$P($$GENTYP^HAD(PRNr),"\")="TBX"
 Quit Is
 
 ; Is TAOR cubic
ISTAORCUB(PRNr,CheckOld) 
 New Is,I,KKey
 If (##class(DOM.DomeinContext).Instance().GeefProductAPI().BestaatProduct(PRNr))
 {
	Set Is=##class(DOM.DomeinContext).Instance().GeefProductTypeAPI().IsTAORIndelingProduct(PRNr)
 }
 ElseIf $G(CheckOld)
 {
 	Set I=$O(^KPRO(PRNr,"I"))
 	Set:$E(I)="I" KKey=$P(^KPRO(PRNr,I),D,4)
 	Set Is=($G(KKey)'="")&&($P($G(^KLAS("K",KKey)),D,8)=##class(DOM.PM.enu.Classificatie).TAOR())
 }
 Quit Is
 
 ; Is tandembox
IsSDM(PRNr) 
 New Is
 Set Is=$P($$GENTYP^HAD(PRNr),D,1,2)="DIV\SDM"
 Quit Is
 ;
 ; Is Aventos product
IsAventos(PRNr) 
 New Is,Key
 Set Key=$O(^KPR(PRNr,"I"))
 Quit:$E(Key)'="I" 0
 Set Is=$P($G(^KPR(PRNr,Key)),"\",1)="02KB "
 Set:Is Is=($$LEVNR(PRNr)=$$$LevBlum)||($$LEVNR(PRNr)=$$$LevHalux)
 Quit Is
 ;
 ; Is Tandem product
IsTandem(PRNr) 
 New Is,KortT
 Set KortT=$G(^KPR(PRNr,0))
 Set Is=0
 Set:KortT?1"T51.17".E Is=1
 Set:KortT?1"T51.70".E Is=1
 Set:KortT?1"550".E Is=1
 Set:KortT?1"560".E Is=1
 Set:KortT?1"566".E Is=1
 Set:KortT?1"295.1000".E Is=1
 Set:KortT?1"T55.0".E Is=1
 Set:KortT?1"T55.11".E Is=1
 Set:KortT?1"T55.71".E Is=1
 Set:KortT?1"T55.8".E Is=1
 Set:KortT?1"T55.91".E Is=1
 Set:KortT?1"ZRE".E Is=1
 Set:KortT?1"295.5600".E Is=1
 Set:KortT?1"298.5500".E Is=1
 Set:KortT?1"298.7600".E Is=1
 ; MOVENTO
 Set:KortT?1"766".E Is=1
 Set:KortT?1"760".E Is=1
 Set:KortT?1"T51.76".E Is=1
 Set:KortT?1"T57.7400".E Is=1
 Set:KortT?1"ZST.1137".E Is=1
 Set:Is Is=$$LEVNR(PRNr)=5005
 Quit Is
 
 ;
 ; Is maatwerk product
IsMaatWerk(PRNr) 
 New IsMaatWerk
 Set IsMaatWerk=''$P($G(^KPR(PRNr,0)),D,3)
 Quit IsMaatWerk
 ;
 ; Produkt is een afdekkap?
IsAfdekKap(PRNr) 
 New IsAfdekKap,IDNr
 Set IDNr=$P(^KPR(PRNr,2),D,25),IsAfdekKap=$E(IDNr)=8
 Quit IsAfdekKap
 ;
IsBeschikbaarVoor(PRNr,Voor)
 New NietBeschikbaarVoor
 If '$D(^KPR(PRNr)) Set NietBeschikbaarVoor=Voor
 Else  Set NietBeschikbaarVoor=$P(^KPR(PRNr,3),D,4)
 Quit (";"_NietBeschikbaarVoor_";")'[(";"_Voor_";")
 ;
ABCKWOT(PRNr,AlleenKw) ; Kwotering (Goed, normaal of slecht) volgens rotatie kriteria per ABC klassificatie
 ; Vb. Rotatie>=16 -> GOED
 ;     Rotatie>=9  -> NORMAAL
 ;     Rotatie< 9  -> SLECHT
KWOTA1 ;16;9
KWOTB1 ;9;4
KWOTC1 ;4;0
KWOTA0 ;49;24
KWOTB0 ;49;24
KWOTC0 ;49;24
 New IsStock,ABC,Rot,CompGood,CompRede,Kwot
 Set IsStock=$P(^KPR(PRNr,1),D,20)
 Set ABC=$P($P(^KPR(PRNr,0),D,8),"#",2)
 Quit:ABC="" ""
 Set Rot=$P($P(^KPR(PRNr,1),D,24),"#",1)
 Set CompGood=$P($T(@("KWOT"_ABC_+IsStock)),";",2)
 Set CompRede=$P($T(@("KWOT"_ABC_+IsStock)),";",3)
 Set Kwot=$S(Rot'<CompGood:"+",Rot'<CompRede:"=",1:"-")
 Quit $S($G(AlleenKw):"",1:ABC)_Kwot
 ;
 ; Beperking opname E-Commerce
ECBeperkKlas(PRNr)
 New RecI,KlasKey,RecKlas
 Set RecI=$O(^KPR(PRNr,"I"))
 Quit:$E(RecI)'="I" 0
 Set KlasKey=$P(^KPR(PRNr,RecI),D,4) ; klaskey van de subgroep
 Set RecKlas=$G(^KLAS("K",KlasKey))
 Quit:'$P(RecKlas,D,12) "S"_D_KlasKey ; Subgroep niet tonen
 Set KlasKey=$P(RecKlas,D,9) ; klaskey van groep
 Set RecKlas=$G(^KLAS("K",KlasKey))
 Quit:'$P(RecKlas,D,12) "G"_D_KlasKey ; Groep niet tonen
 Set KlasKey=$P(RecKlas,D,8) ; klaskey van hoofdgroep
 Set RecKlas=$G(^KLAS("K",KlasKey))
 Quit:'$P(RecKlas,D,12) "H"_D_KlasKey ; HoofdGroep niet tonen
 Quit "" 	
 ;
 ; ExtFormaat 1 of 'E' -> $$EXTDATE^vhLib.DataTypes
GetSchaduwDatum(PRNr,K,ExtFormaat)
 New SchaduwDatum,Default
 Set ExtFormaat=$G(ExtFormaat) Set:ExtFormaat="E" ExtFormaat=1
 Set SchaduwDatum=$S($D(K):K,1:$P(^KPR(PRNr,2),D,27)),Default='SchaduwDatum
 Set:'SchaduwDatum SchaduwDatum=$$GetSchaduwDatum^LEVER($$LEVNR(PRNr))
 If ExtFormaat,SchaduwDatum Set SchaduwDatum=$S(Default:"[",1:"")_$$EXTDATE^vhLib.DataTypes(SchaduwDatum)_$S(Default:"]",1:"")
 Quit SchaduwDatum
 ;
 ; Geldt voor een product de huidige- of de schaduw aankoopprijs
NoSaAankoop(PRNr)
 New NoSa,SchaduwDatum
 Set SchaduwDatum=$$GetSchaduwDatum(PRNr)
 Set NoSa=$S('SchaduwDatum:"",SchaduwDatum'>$H:"S",1:"") ; "S" indien de datum bereikt is (of indien de everancier op schaduw staat - oude software)
 Quit NoSa
 ;
 ; CheckBeperkt: indien =0 -> geen controle op beperkte comm. activiteit (i.v.m. toeleveringen en stockbeheer)
IsCommAkt(PRNr,KLNr,Warn,CheckBeperkt)
 New R,IsCommAkt,From,To,Subject,Body,IsOrgal
 Set KLNr=$G(KLNr),Warn=$G(Warn,1),CheckBeperkt=$G(CheckBeperkt,1),R=$P(^KPR(PRNr,1),D,25),IsCommAkt=$S(R>1:R,1:'R)
 If Warn,'IsCommAkt Do WARN^vhTXTPOP("Product """_$P(^KPR(PRNr,0),D)_""" is commercieel NIET ACTIEF","")
 Do:IsCommAkt=2
 . If 'CheckBeperkt Set IsCommAkt=1 Quit
 . If $$IsOrgaluxOpMaat(PRNr) Set IsCommAkt=1 Quit
 . If 'KLNr Do  Quit
 . . Set IsCommAkt=0
 . . If Warn Do WARN^vhTXTPOP("Product """_$P(^KPR(PRNr,0),D)_""" is BEPERKT commercieel actief","")
 . Set IsOrgal=$$ISORGAL^ORGALUX(PRNr)
 . If IsOrgal Do
 . . Quit:"\1239\11708\"[(D_KLNr_D)
 . . Set IsCommAkt=0
 . Else  Set IsCommAkt=''$D(^KSTKL(KLNr,PRNr))
 . Quit:IsCommAkt  Quit:'Warn
 . Set IsCommAkt=$$^vhTXTPOP("PRODUKT","ISCOMMAKT","",$P(^KPR(PRNr,0),D),$P(^KKL(^KK1(KLNr),0),D,2))
 . Quit:'IsCommAkt  Quit:IsOrgal
 . Quit  ; Mail niet meer versturen naar Peter Van Hoecke
 . Set From=##class(TECH.Context.RuntimeContext).Instance().GeefServerNaam()_"@VANHOECKE.BE"
 . Set To=$$MailTo^vhUSER("PVH",1)
 . Set Subject=""""_$P(^KPR(PRNr,0),D)_""" BEPERKT commercieel actief"
 . Set Body="Product """_$P(^KPR(PRNr,0),D)_""" is BEPERKT commercieel actief."
 . Set Body=Body_$C(13)_$P(^KKL(^KK1(KLNr),0),D,2)_" had tot op heden geen toegang tot dit product."
 . Set Body=Body_$C(13)_"Door "_$$USERNAME^vhUSER()_" werd toegang tot het product verleend."
 . Set R=$$SendMiniMail^vhLib(From,To,Subject,Body)
 Quit IsCommAkt
 ;
 ; Geeft een LB terug van het RecuPakPRNr en het aantal
GetRecuPak(PRNr)
 New J,R,RecuPakPRNr,RecuPakAantal
 Set J=$O(^KPR(PRNr,"J"))
 If $E(J)="J" Set R=^(J),RecuPakPRNr=$P(R,"\",32),RecuPakAantal=$P(R,"\",33)
 Quit $LB($G(RecuPakPRNr),$G(RecuPakAantal))
 ;
 ; Geeft de lengte van een maatwerkproduct
GetLengte(PRNr)
 New Lengte
 Set Lengte=$P($G(^KPR(PRNr,"G")),D,3)
 Set:Lengte'?1.4N Lengte=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("GRP",PRNr,"LG"))
 Set:Lengte'?1.4N Lengte=$LG(##class(Prod.Kenmerk.DataDefinitie).Get("TLM",PRNr,"LP"))
 Quit Lengte
 ; 
 ; Product enkel voor Halux?
IsOnlyHalux(PRNr)
 Quit $E($P($G(^KPR(PRNr,0)),D,23),1,2)="HH"
 ;
 ; Test op FSC-code
 ; IsFSC = 1    -> test FSC hout
 ;       = code -> test op specifieke FSC-code   
IsHout(PRNr,IsFSC)
 New IsHout,FSCCode
 Set FSCCode=$P($G(^KPR(PRNr,3)),"\",5),IsHout=''$L(FSCCode)
 If IsHout,$L($G(IsFSC)) Set IsHout=$S(IsFSC=1:(FSCCode'="GEEN"),1:(IsFSC=FSCCode))
 Quit IsHout
 ;
GetFSCCodeEnGewicht(PRNr,Aantal)
 New FSCCode,FSCGewicht,FSCCodeEnGewicht
 Do ##class(DOM.PM.HoutCertificaatService).%New().CodeAndGewicht(PRNr,Aantal,.FSCCode,.FSCGewicht)
 Set FSCCodeEnGewicht=$S(FSCCode="GEEN":"",1:FSCCode_$S(FSCCode'="":";"_FSCGewicht,1:""))
 Quit FSCCodeEnGewicht
 ;