#include Prod.Product
PRODUKT ;PRODUKTEN [ 09/29/2003  11:47 AM ]
 
RAADPL(PRNr,Screen,NoMod) 
 Set:'$D(Screen) Screen=""
 New (%ZR,%ZM,Q,QL,QM,QN,QO,QRVG,QT,QTU,QU,QW,QZ,D,DT,TD,DD,DM,DJ,F70,F71,U,boot,cs,master,workst,io,QP,QD,%Q1,PRNr,Screen,NoMod,sJC,sScr,sProgLog,RK)
 Xecute F71
 Set LScreen=Screen,Aktie=""
 If '$D(^KPR(PRNr)) Quit LScreen_D_Aktie
 Set EXTERN=1,PARAM=PRNr_D_Screen
 Do ^RPLPR
 Set Aktie=$G(Aktie),LScreen=$G(LScreen)
 Set Aktie=$S(Aktie="(":"P",Aktie=")":"N",1:"")
 Quit LScreen_D_D_Aktie
 ;
 ;
WIJZIG(PRNr,Screen,Element) 
 Set:'$D(Screen) Screen="" Set:'$D(Element) Element=""
 Lock  ZD
 New (%ZR,%ZM,Q,QL,QM,QN,QO,QRVG,QT,QTU,QU,QW,QZ,D,DT,TD,DD,DM,DJ,F70,F71,U,boot,cs,master,workst,io,QP,QD,%Q1,PRNr,Screen,Element,sCJ,sScr,sProgLog,RK)
 Xecute F71
 Set LScreen=$G(Screen),LElement=$G(Element),Aktie=""
 If '$D(^KPR(PRNr)) Quit LScreen_D_LElement_D_Aktie
 Set EXTERN=1
 Do ^KPE30
 Set Aktie=$S(Aktie="(":"P",Aktie=")":"N",1:"")
 Lock  ZD
 Quit LScreen_D_LElement_D_Aktie
 ;
 ;Opvragen klassificatie bij Afdrukken  Prijsuitzondering
 ;***** Te vervangen door SELECT^KLAS
KLASKEY(Ref,Key) 
 New H,G,S,h,g,s,R
 If '$D(Key) Set Key="HGS"
 If $L(Ref) For  Quit:$E(Ref)'?.N  Set Ref=$E(Ref,2,99)
 If Key["H",$L($P(Ref,"-")) Do
 .Set H=$P(Ref,"-") Quit:H=""  Set h=""
 .For  Set h=$O(^KPHG(h)) Quit:h=""  Set R=$P(^KPHG(h),D,2) If $E(R,$L(R)-$L(H)+1,$L(R))=H Set H=R Quit
 If Key["G",$L($P(Ref,"-",2)) Do
 .Set G=$P(Ref,"-",1,2) Quit:G=""  Set g=""
 .For  Set g=$O(^KPGR(g)) Quit:g=""  Set R=$P(^KPGR(g),D,2) If $E(R,$L(R)-$L(G)+1,$L(R))=G Set G=R Quit
 If Key["S",$L($P(Ref,"-",3)) Do
 .Set S=$P(Ref,"-",1,3) Quit:S=""  Set s=""
 .For  Set s=$O(^KPSG(s)) Quit:s=""  Set R=$P(^KPSG(s),D,2) If $E(R,$L(R)-$L(S)+1,$L(R))=S Set S=R Quit
 Set R="" For I=1:1:$L(Key) If $D(@$E(Key,I)) Set R=R_D_@$E(Key,I)
 Set $E(R)=""
 Quit R
 ;
 ; Vorig of volgend produkt in KPH 
 ; Gebruikt in raadplegen en wijzigen produkten
NEXT(Via,PRNr,Dir,NoDo) 
 New I,J,R,PRCd,PRCCd,PRId,PRCId,HoofdGr,Groep,SubGroep,Merk,LimV,LimT,LEVNr,LevRef
 New pxCriteria,blSearch
 Set LimT=$P($G(sRef("SELPR")),D,1),LimV=$P($G(sRef("SELPR")),D,2)
 Do InitCriteria(LimT,LimV,$G(Nodo),$G(PoolKLNr))
 If '$D(Dir) Set Dir=1
 If Dir'=1,Dir'=-1 Set Dir=$S(Dir="P":-1,1:1)
 If Via="P" Do  Quit PRNr                                          
 .For  Do  Quit:'PRNr  If $P(^KPR(PRNr,1),D,25)'=1 Quit:$$CHECK(PRNr)
 ..Set PRCd=$$COMPR(PRNr)
 ..Set PRCd=$O(^KPR1(PRCd),Dir)
 ..Set PRNr=$S($L(PRCd):$P(^KPR1(PRCd),D),1:"")
 .Set %SelProd("PRNr")=PRNr
 If Via="I" Do  Quit PRNr
 .For  Do  Quit:'PRNr  If $P(^KPR(PRNr,1),D,25)'=1 Quit:$$CHECK(PRNr)
 ..Set PRId=$P(^KPR(PRNr,2),D,25),PRCId=$$TRIMIDENT^vhRtn1(PRId) ;[IDENT] CW
 ..Set PRCId=$O(^KPR2(PRCId),Dir)
 ..Set PRNr=$S($L(PRCId):$P(^KPR2(PRCId),D),1:"")
 .Set %SelProd("PRNr")=PRNr
 If Via="K" Do  Quit PRNr
 .For  Do  Quit:'PRNr  If $P(^KPR(PRNr,1),D,25)'=1 Quit:$$CHECK(PRNr)
 ..Set PRCd=$$COMPR(PRNr)
 ..Set R="",I=$O(^KPR(PRNr,"I")) If $E(I)="I" Set R=^KPR(PRNr,I)
 ..Set HoofdGr=$P(R,D),Groep=$P(R,D,2),SubGroep=$P(R,D,3),Merk="  "
 ..Set R=$Q(^KPH(HoofdGr,Groep,SubGroep,Merk,PRCd),Dir)
 ..Set PRNr=$S($L(R):$P(@R,D),1:"")
 .Set %SelProd("PRNr")=PRNr
 If Via="L" Do  Quit PRNr
 .For  Do  Quit:'PRNr  If $P(^KPR(PRNr,1),D,25)'=1 Quit:$$CHECK(PRNr)
 ..Set PRCd=$$COMPR(PRNr)
 ..Set R="",J=$O(^KPR(PRNr,"J")) If $E(J)="J" Set R=^KPR(PRNr,J)
 ..Set LEVNr=$P(R,D),LevRef=$P(R,D,3),Merk="  "
 ..Set R=$Q(^KPL(LEVNr_" ",Merk,LevRef_" ",PRCd),Dir)
 ..Set PRNr=$S($L(R):$P(@R,D),1:"")
 .Set %SelProd("PRNr")=PRNr
 Quit ""
 ;
CHECK(PRNr)
 Set IdentNr=$P(^KPR(PRNr,2),D,25)
 Set pxCriteria.At="I"
 Set CompresKey=$TR(IdentNr,".","")_" "
 Set IndexContent=^Prod.SearchIndexD(pxCriteria.At,CompresKey,PRNr)
 Do blSearch.SetDefault(pxCriteria)
 If 'blSearch.CheckCriteria(PRNr,pxCriteria,IndexContent) Quit 0   ; Deze is met Try-Catch geïmplementeerd.
 Quit 1
 
 ; initialize pxCriteria 
InitCriteria(LimT,LimV,Opties,PoolKLNr)
 Set pxCriteria=##class(BL.Prod.sub.pxSearchCriteria).%New()
 Set blSearch=##class(BL.Prod.Search).%New()
 ;translate of the options in pxCriteria
 Set pxCriteria.Usage="ALL"
 If Opties["NODO" Set pxCriteria.StockType=$LB("S","N","C")
 If Opties["NOKP" Set pxCriteria.Saleable=$LB("S","H")
 If PoolKLNr Do
 . Set pxCriteria.Pool=$S(IsKSCust:$LB("KS"),1:$LB("IP"))
 . Set pxCriteria.VerifyCustomer=PoolKLNr
 If LimT="L" Set pxCriteria.LimitSupplier=LimV
 If LimT="KL" Do
 . Set Lijst=""
 . Set xKlas=^KLAS("K",LimV)
 . If $Piece(xKlas,D)=1 Do
 . . Set code=""
 . . For  Set code=$o(^KLAS("K",code)) quit:code=""  Do
 . . . If $Piece(^KLAS("K",code),D,8)=LimV Set Lijst=Lijst_$LB(code)
 . Else  If $Piece(xKlas,D)=2 Do
 . . Set code=""
 . . For  Set code=$o(^KLAS("K",code)) quit:code=""  Do
 . . . If $Piece(^KLAS("K",code),D,9)=LimV Set Lijst=Lijst_$LB(code)
 . Else  Set Lijst=$LB(LimV)
 . Set pxCriteria.lbLimitKlasKeys=Lijst
 If LimT="K" Set pxCriteria.LimitCustomer=LimV
 Quit 
 
 
COMPRES(KortTxt,Sectie,Stock,IdentNr) 
 New I,Out
 Set Stock=$G(Stock)
COMPR2 
 Quit ##class(BL.Prod.SearchBuildIndex).CompressKortTekst(KortTxt, Sectie, Stock, IdentNr)

COMPR(PRNr) 
 New I,Out,Sectie,Stock,KortTxt,IdentNr
 Set Sectie="",I=$O(^KPR(PRNr,"I")) Set:$E(I)="I" Sectie=$P(^KPR(PRNr,I),"\",5)
 Set Stock=$P(^KPR(PRNr,1),"\",20),KortTxt=$P(^(0),"\",1),IdentNr=$P(^(2),"\",25)
 Goto COMPR2
 ;
ALFASRT(KortT) 
 New List,Alfa,KTC,KTB,K,KT,Char,PrevChar,Prev
 Set KTC=$$COMPRES(KortT)
 Set KTB=$E(KTC,1,3)
 Set KT=KTB_" "
 Set PrevChar=" ",Prev=KT,$E(Prev,4)=""
 For  Set KT=$O(^KPR1(KT)) Quit:KT=""!($E(KT,1,3)'=KTB)  Do
 .Set K=KT,$E(K,4)=""
 .If K]KTC,'$D(Alfa(PrevChar)) Set List(Prev)=PrevChar,Alfa(PrevChar)=""
 .Set Prev=K,PrevChar=$E(KT,4)
 Set Char=""
 Set KT=""
 For  Set KT=$O(List(KT)) Quit:KT=""  Do
 .If KT]KTC Set KT="ZZZZZ" Quit
 .Set Char=List(KT)
 Set:Char=" " Char=""
 Quit Char
 ;
 ; Niv : 1=HfdGrp,2=Grp,3=SubGrp,Rest=Prod
SORTKEY(PRNr,Niv) 
 New I,R,KKey,SortKey,D
 Set D="\"
 Set Niv=$G(Niv),I=$O(^KPR(PRNr,"I"))
 If Niv'=1,Niv'=2,Niv'=3 Set Niv=4
 If $E(I)'="I" Set SortKey=""
 Else  Do
 .Set R=^KPR(PRNr,I)
 .If Niv<4 Set SortKey=$P(R,D,Niv)
 .Else  Set SortKey=$P(R,D,3)_$$COMPR(PRNr)
 Quit SortKey
 ;
SORTKEYTypeEnKleur(PRNr,Niv) 
 New I,R,KKey,SortKey,D,KTekst, Kleur, PrType
 Set D="\"
 Set KTekst = $P(^KPR(PRNr,0),"\")
 Set Kleur=$E(KTekst,$L(KTekst)-3,$l(KTekst))
 Set PrType=$E(KTekst,1,4)
 Set Niv=$G(Niv),I=$O(^KPR(PRNr,"I"))
 If Niv'=1,Niv'=2,Niv'=3 Set Niv=4
 If $E(I)'="I" Set SortKey=""
 Else  Do
 .Set R=^KPR(PRNr,I)
 .If Niv<4 Set SortKey=$P(R,D,Niv)
 .Else  Set SortKey=$P(R,D,3)_PrType_Kleur_$$COMPR(PRNr)
 Quit SortKey
 ;
 ; Nieuw PRNr
NEXTID(NoLDISP) 
 New R,PRNr,MailId
 For  Lock +^KPR(0,1):2  Quit:$T  Else  Do:'$G(NoLDISP) LDISP^vhLock("^KPR(0,1)","Uniek produktnr")
 Set PRNr=$G(^KPR(0,1)) 
 If PRNr = 999998
 {
	Set ^KPR(0,1) = PRNr+3
 }Else{
	Set ^KPR(0,1)=PRNr+1	
 }
 If PRNr=100000 Do
 .Set R="ªKAandacht !!!ªk~~Het huidig nummer is "_PRNr_" of hoger.~Gelieve na te zien."
 .Set MailId=$$SYSTEM^vhMAIL("","Produkten","Intern nummer","SYS",R,"",1,1)
 Lock -^KPR(0,1)
 Quit PRNr
 ;
IDENTNR(PRNr,BeginNr) 
 New IdentNr,Kleur,Som,X
 Set:$G(BeginNr)="" BeginNr="9"
 Set Kleur=PRNr\100000,X=PRNr#100000,X=$TR($J(X,5,0)," ",0)
 Set Som=$E(X)*6+($E(X,2)*5)+($E(X,3)*4)+($E(X,4)*3)+($E(X,5)*2)#11
 Set Som=$S(Som=0:1,Som=1:0,1:11-Som)
 Set IdentNr=BeginNr_"."_$E(X,1,3)_"."_$E(X,4,5)_Som_"."_Kleur
 Quit IdentNr
 
VERWERKT(Total,Selected,Line,Column) 
 Set Total=$G(Total),Selected=$G(Selected),Line=$G(Line,20),Column=$G(Column,21)
 Set FP=Line*100+(Column-19)
 Write @F,"Produkten verwerkt : " Write Total Write:Selected "/",Selected Write @F2
 Quit
 ;
 ; Een productveld invullen in ^KPR en in de Log
MODFIELD(PRNr,BIndex,NewValue,PutLog,RubrName,AppendNm)
 ; BIndex is met 100 verhoogd = (Node+1)*100+Piece
 New R,Node,Piece,OldValue,NBIndex
 Set Node=$$UPTRIMA^vhRtn1(BIndex),NBIndex=$$TRIMN^vhRtn1(BIndex),Piece=NBIndex#100
 If Node="" Set Node=BIndex\100-1
 Else  Set Node=$O(^KPR(PRNr,Node))
 Set R=$G(^KPR(PRNr,Node)),OldValue=$P(R,D,Piece)
 Do:OldValue'=NewValue
 . Do ##class(BL.Legacy.ProductEvents).ClearEventInformation()
 . New ReBuildIndex
 . Set ReBuildIndex=##class(BL.Prod.SearchBuildIndex).CheckForRebuild(BIndex)
 . Lock +^KPR(PRNr)
 . Do:ReBuildIndex DELIND^PRODUKT2(PRNr)
 . Set $P(R,D,Piece)=NewValue,^KPR(PRNr,Node)=R
 . Do:$G(PutLog,1) DLOGMOD^LOG("PR",PRNr,BIndex,OldValue,NewValue,.RubrName,.AppendNm)
 . Do:ReBuildIndex BLDIND^PRODUKT2(PRNr)
 . Lock -^KPR(PRNr)
 . D ##class(BL.Legacy.ProductEvents).RaiseEvents()
 Quit
 
Set(PRNr,BIndex,NewValue,RubrName)
 Set:'$D(QU)&&$isObject($G(%Application)) QU=%Application.User.Initialen
 Set QU=$G(QU)
 If '$D(D) Do ; Initialisatie van alle std. locals
 . New PRNr,BIndex,NewValue,RubrName,QU
 . Set Q="K"
 . D ^cA604
 Set boot=##class(TECH.Context.RuntimeContext).Instance().GeefServerNaam()
 Do MODFIELD(PRNr,BIndex,NewValue,1,.RubrName)
 Quit
 
Get(PRNr,BIndex)
 New R,Node,Piece,OldValue,NBIndex
 Set Node=$$UPTRIMA^vhRtn1(BIndex),NBIndex=$$TRIMN^vhRtn1(BIndex),Piece=NBIndex#100
 If Node="" Set Node=BIndex\100-1
 Else  Set:Node'="G" Node=$O(^KPR(PRNr,Node))   // Geen $O bij "G" ( JCL 11.07.09 )
 Set R=$G(^KPR(PRNr,Node))
 Quit $P(R,"\",Piece)
 
GetOrOld(PRNr,BIndex)
 New R,Node,Piece,OldValue,NBIndex
 Set Node=$$UPTRIMA^vhRtn1(BIndex),NBIndex=$$TRIMN^vhRtn1(BIndex),Piece=NBIndex#100
 If $D(^KPR(PRNr)) Do
 . If Node="" Set Node=BIndex\100-1
 . Else  Set Node=$O(^KPR(PRNr,Node))
 . Set R=$G(^KPR(PRNr,Node))
 Else  Do
 . If Node="" Set Node=BIndex\100-1
 . Else  Set Node=$O(^KPRO(PRNr,Node))
 . Set R=$G(^KPRO(PRNr,$S(Node="":"*",1:Node)))
 Quit $P(R,"\",Piece)
 
lbVerpak(PRNr)
 If $D(^KPR(PRNr)) Do
 . Set Node=$O(^KPR(PRNr,"J"))
 . Set R=$G(^KPR(PRNr,Node))
 Else  Do
 . Set Node=$O(^KPRO(PRNr,"J"))
 . Set R=$G(^KPRO(PRNr,$S(Node="":"*",1:Node)))
 Set GVpk=$P(R,"\",$E($$$GrootVerpakking,2,9))
 Set NVpk=$P(R,"\",$E($$$NormaleVerpakking,2,9))
 Set KVpk=$P(R,"\",$E($$$KleinVerpakking,2,9))
 Set lbResult=$LB(GVpk)
 Set:NVpk&&(GVpk'=NVpk) lbResult=lbResult_$LB(NVpk)
 Set:KVpk&&(NVpk'=KVpk) lbResult=lbResult_$LB(KVpk)
 Quit lbResult
 
 ; Logging van produktwijzigingen
 ; B doorgegeven als .Local
LOGPRNR(PRNr,B) 
 Do DLOG^LOG("PR",PRNr,.B)
 Quit
 ;
 ; Invullen van de log per rubriek
 ; BIndex is optioneel en indien meegegeven
 ;        xxx = de waarde van $P(^KPR(0,...),";",16)
 ;        Ixxx (Klassifikatie)
 ;        Jxxx (Leverancier)
 ; RubrName is optioneel indien BIndex is meegegeven
 ; AppendNm is optioneel
PUTLOG(PRNr,BIndex,OldValue,NewValue,RubrName,AppendNm) 
 Do DLOGMOD^LOG("PR",PRNr,$G(BIndex),$G(OldValue),$G(NewValue),$G(RubrName),$G(AppendNm))
 Quit
 ;
VOLUME(PRNr) ; Volume van 1 stuk in cm3
 New IDNr,BLID,Volume,Rec,GVP
 Quit:'$D(^KPR(PRNr,"J5005")) ""
 Set IDNr=$P(^KPR(PRNr,2),D,25)
 Set BLID="0"_$TR($E(IDNr,2,99),".","")
 Set BLRec=$G(^BLProd("D",BLID))
 Quit:BLRec="" ""
 Set GVP=$P(BLRec,D,6)
 Set:'GVP GVP=$P(BLRec,D,5)
 Set:'GVP GVP=$P(BLRec,D,4)
 Quit:'GVP ""
 Set Volume=$P(BLRec,D,23)*$P(BLRec,D,24)*$P(BLRec,D,25)*$P(BLRec,D,22)/GVP ; H*B*D*Faktor/GVP
 Quit $J(Volume,0,0)
 
VERPAKDIM(PRNr) ; Volume van 1 stuk in cm3
 New IDNr,BLID,Volume,Rec,GVP
 Quit:'$D(^KPR(PRNr,"J5005")) ""
 Set IDNr=$P(^KPR(PRNr,2),D,25)
 Set BLID="0"_$TR($E(IDNr,2,99),".","")
 Set BLRec=$G(^BLProd("D",BLID))
 Quit:BLRec="" ""
 Set GVP=$P(BLRec,D,6)
 Set:'GVP GVP=$P(BLRec,D,5)
 Set:'GVP GVP=$P(BLRec,D,4)
 Quit $LB($P(BLRec,D,23),$P(BLRec,D,24),$P(BLRec,D,25),$P(BLRec,D,22), GVP) ; H, B, D, Faktor, GVP
 ;
 ; PRODGRP geeft APPS.PM.enu.ProductGroep terug.
PRODGRP(PRNr,CheckOldProducts) 
 New Groep,GenTyp,Key,LevNr,ProductTypeAPI
 #dim Groep As APPS.PM.enu.ProductGroep
 Set LevNr=$E($O(^KPR(PRNr,"J")),2,5)
 Set:LevNr=""&&$G(CheckOldProducts) LevNr=$E($O(^KPRO(PRNr,"J")),2,5) ; Old
 If LevNr=5005 Quit "BLUM"
 ;If LevNr=6502 Quit "GRP"
 If LevNr=6332 Do  Quit Groep  ; HALUX
 .Set Groep="HAL"
 .Set GenTyp=$$GENTYP^HAD(PRNr,.CheckOldProducts)
 .;If GenTyp["GRP" Set Groep="GRP"
 .If GenTyp["TBX" Set Groep=##class(APPS.PM.enu.ProductGroep).Tandembox()
 .If GenTyp["LBX" Set Groep=##class(APPS.PM.enu.ProductGroep).Legrabox()
 .If GenTyp["TAO" Set Groep=##class(APPS.PM.enu.ProductGroep).TAORBOX()
 .If GenTyp["MVX" Set Groep=##class(APPS.PM.enu.ProductGroep).Merivobox()
 Set Key=$O(^KPR(PRNr,"I"))
 If $E(Key)="I" Quit:$P(^KPR(PRNr,Key),"\")["OL" "OL"
 Else  If $G(CheckOldProducts)  Set Key=$O(^KPRO(PRNr,"I")) If $E(Key)="I" Quit:$P(^KPRO(PRNr,Key),"\")["OL" "OL"  

 Set Groep = "REST"
 Set ProductTypeAPI=##class(DOM.DomeinContext).Instance().GeefProductTypeAPI()
 Try {
	If ('##class(DOM.DomeinContext).Instance().GeefProductAPI().BestaatProduct(PRNr)) {
		If $G(CheckOldProducts,1)  Set Key=$O(^KPRO(PRNr,"I")) If $E(Key)="I" Set:($P(^KPRO(PRNr,Key),"\",1)["TA") Groep=##class(APPS.PM.enu.ProductGroep).TAORIndeling()
	}
	ElseIf ProductTypeAPI.IsTAORIndelingProduct(PRNr){
	 	Set Groep = ##class(APPS.PM.enu.ProductGroep).TAORIndeling()
 	}
 }Catch E{
	#dim Exception As TECH.Exceptions.Exception = ##class(TECH.ExceptionHandler).Catch()
	Do ##class(vhLib.Logger).%New("PRODUKT").WarningMail("PRODGRP","Nog definitief oplossen !!! "_$C(13,10)_"ProductGroep 'REST' wordt automatisch geselecteerd omdat Product '"_PRNr_"' niet meer bestaat."_$C(13,10)_Exception.ToString())
 }
 
 Quit Groep
 ;
 ; Verzenden van mail naar Haefele bij het openen, dupliceren en wijzigen van een KS product
MailHaefele(PRNr,Type,OldValue)
 New R,KortText
 Do:##class(BL.Derde.Klant.Haefele).%New().CheckSend(PRNr,Type,.OldValue)
 . Set R=^KPR(PRNr,0),KortText=$P(R,D)
 . Quit:'$$^vhTXTPOP("KLANT","PRODHAEFELE","",KortText)
 . Do ##class(BL.Derde.Klant.Haefele).%New().SendKSProduct(PRNr,Type,.OldValue)
 Quit
 ;
LocalY
 Set Count=Count+1,Y(Count+Max)=PRT
 If PRT=$G(%SelProd("PRNr")) Set %SelProd("X")=Count+Max  Kill %SelProd("PRNr")
 Quit
 ;
 ; Controle korttekst en identnr voor openen en wijzigen producten i.v.m. aliassen
ValidateFromBNode(PRNr,B,KortTxt,IDNr)
 New bl,I,R,Dubbels,Count,Validate,lbDubbel,LD,Input,BNode
 Do STORE^vhTERMINA()
 Merge BNode=B
 Set BNode("J")=$G(BNode("J"))
 Set:$D(KortTxt) $P(BNode(1),D)=KortTxt
 Set:$D(IDNr) $P(BNode(3),D,25)=IDNr
 Set bl=##class(BL.Prod.SearchBuildIndex).Instantiate()
 Do bl.Init($G(PRNr))
 Set Validate=bl.ValidateFromBNode(.BNode)
 Set Count=0
 For I=1:1:$LL(Validate) Do
 . Set lbDubbel=$LI(Validate,I)
 . Quit:$G(PRNr)=$LI(lbDubbel) ; Zichzelf
 . Set Count=Count+1,Dubbels(Count)=$LI(lbDubbel)_D_$LI(lbDubbel,5)_D_$LI(lbDubbel,3)
 Do:Count
 . Do INIT^vhLIST("PRODUKT","VALKTIDNR",.LD)
 . Set R=LD("POS"),$P(R,";")=$P(R,";")-(Count\2),$P(R,";",3)=$P(R,";")+Count-1,LD("POS")=R
 . Do WRITE^vhLIST(.LD)
 . For  Set Input=$$SCROLL^vhLIST(.LD)  Quit:Input="O"
 Do REFRESH^vhTERMINA()
 Quit 'Count
 ;
 ; Opzoeken van het spiegelproduct
GetMirror(PRNr)
 New MultiMirror,blProdSelect,MirrorPRNr,MirrorLR,CurrentLR,lbMultiPRNrs,MaxLG
 Set blProdSelect=##class(BL.Prod.Select).Instantiate()
 Do blProdSelect.GetMirror(PRNr,.MirrorPRNr,.MirrorLR,.CurrentLR,.lbMultiPRNrs)
 If $LL($g(lbMultiPRNrs)) Do
 . Set MaxLG=5
 . For MaxLG=1:1:MaxLG Set:MaxLG'>$LL(lbMultiPRNrs) MultiMirror(MaxLG)=$S(MaxLG=1:"Spiegelproducten: ",1:$J("",18))_$$$ProductGet($LI(lbMultiPRNrs,MaxLG),$$$KortTekst)
 . Set:$LL(lbMultiPRNrs)>MaxLG MultiMirror(MaxLG+1)=$J("",18)_"..."
 . Set MultiMirror="MultiMirror",Mirror=$$^vhTXTPOP("PRODUKT","MULTIMIRROR","",$$$ProductGet(PRNr,$$$KortTekst))
 Quit MirrorPRNr
 ;
 ; Spiegelproduct toevoegen?
AddMirror(PRNr,Aantal)
 New Mirror,MirrorPRNr
 Set MirrorPRNr=$$GetMirror(PRNr)
 If MirrorPRNr?4.7N Do
 . If $$^vhTXTPOP("PRODUKT","MIRROR","",$$$ProductGet(PRNr,$$$KortTekst),$$$ProductGet(MirrorPRNr,$$$KortTekst),Aantal) Set Mirror=MirrorPRNr_"#"_Aantal
 . Else  Set Mirror=""
 Else  Set Mirror=""
 Quit Mirror
 ;
 ; Spiegelproduct wijzigen?
ModMirror(PRNr,Aantal)
 New Mirror,MirrorPRNr
 Set MirrorPRNr=$$GetMirror(PRNr)
 If MirrorPRNr?4.7N Do
 . If $$^vhTXTPOP("PRODUKT","MODMIRROR","",$$$ProductGet(PRNr,$$$KortTekst),$$$ProductGet(MirrorPRNr,$$$KortTekst),Aantal) Set Mirror=MirrorPRNr_"#"_Aantal
 . Else  Set Mirror=""
 Else  Set Mirror=""
 Quit Mirror
 ;
 ; Spiegelproduct verwijderen?
DelMirror(PRNr)
 New Mirror,MirrorPRNr
 Set MirrorPRNr=$$GetMirror(PRNr)
 If MirrorPRNr?4.7N Do
 . If $$^vhTXTPOP("PRODUKT","DELMIRROR","",$$$ProductGet(PRNr,$$$KortTekst),$$$ProductGet(MirrorPRNr,$$$KortTekst)) Set Mirror=MirrorPRNr
 . Else  Set Mirror=""
 Else  Set Mirror=""
 Quit Mirror
 ;