PRHIST ; Produkten historiek [ 11/05/2003  11:21 AM ]
 ;
 ; WMS doorgegeven als .Local
 ; WMS(1)="BronPal\PalAant\Date\User\DoelPal\FysMag"
 ; WMS(2)=...
 ; WMS(...)=...
PUT(PRNr,Aantal,Type,Magazijn,Derde,BTNr,BTLUNr,Date,RFNr,Refer,WMS,HNUser,MPRNr,OrdDat,FSCHout) 
 New I,R,HistNr,SubNr,Stock,BronPal,DoelPal,PalAant,User,Waarde,UserId,FSCCode,FSCGewicht
 Set Magazijn=$G(Magazijn,"M"),Derde=$G(Derde),BTNr=$G(BTNr),BTLUNr=$G(BTLUNr)
 Set Date=$G(Date),RFNr=$G(RFNr),Refer=$G(Refer),HNUser=$G(HNUser),MPRNr=$G(MPRNr) Set:MPRNr=PRNr MPRNr=""
 Set OrdDat=$G(OrdDat)
 If '$D(FSCHout) 
 {
	Do ##Class(DOM.PR.FSC).CodeAndGewicht(PRNr,Aantal,.FSCCode,.FSCGewicht)
	Set FSCHout=FSCCode_$S(FSCCode'="":";"_FSCGewicht,1:"")
 }
 Else  { ; Enkel het gewicht herberekenen
	Set FSCCode=$P(FSCHout,";")
	If "GEEN"'[FSCCode {
		Do ##Class(DOM.PR.FSC).CodeAndGewicht(PRNr,Aantal,.FSCCode,.FSCGewicht)
		Set $P(FSCHout,";",2)=FSCGewicht
	}
 }
 If Magazijn="W" Set R=$G(^PRSTOCK("D",PRNr)),Stock=$P(R,D,5)
 Else  Set R=^KPR(PRNr,0),Stock=$P(R,D,14)
 Set Waarde=$J($P($$PRIJSGEG^KPRIJS(PRNr),D,6)*Aantal,0,2) ; omgezet van CIFPPLPR naar PRIJSGEG
 If $E($G(Refer),1,2)="**" Set Refer="",Type="O" ;Optimalisatie
 If Type="M",+Aantal=0 Set Type="E" ; Bij manuele correctie wordt het type omgezet naar E = Telling zonder stockwijziging (meestal bij lege pallet)
 If Type="D",+Aantal=0 Set Type="Z" ; Bij manuele correctie en met AUTOCC flag wordt het type omgezet naar Z = Telling zonder stockwijziging (meestal bij lege pallet)
 ;Set R=$H_D_Aantal_D_Stock_D_Type_D_Magazijn_D_Derde_D_BTNr_D_BTLUNr_D_Date_D_RFNr_D_Refer_D_Waarde_D_D_D_MPRNr_D_OrdDat_D_FSCHout
 Set R=$S(+$H=60447:"60446,82800",1:$H)_D_Aantal_D_Stock_D_Type_D_Magazijn_D_Derde_D_BTNr_D_BTLUNr_D_Date_D_RFNr_D_Refer_D_Waarde_D_D_D_MPRNr_D_OrdDat_D_FSCHout
 Set HistNr=$O(^PRHIST(PRNr,""),-1)+1,^PRHIST(PRNr,HistNr)=R
 If $D(WMS) For I=1:1 Quit:'$D(WMS(I))  Do
 .Set R=WMS(I),User=$P(R,D,4) Set:$E(User,1,5)=$J("",5) User=""
 .Set UserId=$$USERID(User),$P(R,D,4)=$S(UserId:UserId,1:User) Set:HNUser="" HNUser=UserId
 .Quit:$TR(R,D,"")=""
 .Set SubNr=$O(^PRHIST(PRNr,HistNr,""),-1)+1,^PRHIST(PRNr,HistNr,SubNr)=R
 Do:$L(HNUser)
 .Set UserId=$$USERID(HNUser),R=^PRHIST(PRNr,HistNr)
 .Set $P(R,D,14)=$S(UserId:UserId,1:HNUser),^PRHIST(PRNr,HistNr)=R
 If Type="U",BTNr,BTLUNr Set ^PRHISTI("B",BTNr,BTLUNr,PRNr)=HistNr
 If Type="V",BTNr,BTLUNr Do
 .Set R=$G(^PRHISTI("B",BTNr,BTLUNr,PRNr))
 .Quit:D_R_D[(D_HistNr_D)
 .Set:$L(R) R=R_D
 .Set R=R_HistNr,^PRHISTI("B",BTNr,BTLUNr,PRNr)=R
 Quit
 ;
 ; Invullen faktuur/proforma nummer bij fakturatie
FANR(KLNr,BONNr,BLNr,FANr) 
 New R,PRNr,BLUNr,HistNr,HistNrs
 Set R=^KUL(KLNr,"F",BONNr,BLNr),PRNr=$P(R,D,2),BLUNr=$P(R,D,15)
 Do:BLUNr
 .If $O(^PRHISTI("B",BONNr,BLUNr,"")) Do
 ..Set PRNr=""
 ..For  Set PRNr=$O(^PRHISTI("B",BONNr,BLUNr,PRNr)) Quit:PRNr=""  Do
 ...Set HistNrs=^PRHISTI("B",BONNr,BLUNr,PRNr)
 ...For  Quit:HistNrs=""  Do
 ....Set HistNr=$P(HistNrs,D),HistNrs=$P(HistNrs,D,2,99)
 ....Quit:'HistNr
 ....Set R=$G(^PRHIST(PRNr,HistNr))
 ....If $P(R,D,6)=KLNr,$P(R,D,7)=BONNr,$P(R,D,8)=BLUNr Set $P(R,D,10)=FANr,^PRHIST(PRNr,HistNr)=R
 .Else  Do:PRNr
 ..Set HistNrs=$G(^PRHISTI("B",BONNr,BLUNr))
 ..For  Quit:HistNrs=""  Do
 ..Set HistNr=$P(HistNrs,D),HistNrs=$P(HistNrs,D,2,99)
 ..Quit:'HistNr
 ..Set R=$G(^PRHIST(PRNr,HistNr))
 ..If $P(R,D,6)=KLNr,$P(R,D,7)=BONNr,$P(R,D,8)=BLUNr Set $P(R,D,10)=FANr,^PRHIST(PRNr,HistNr)=R
 .Kill ^PRHISTI("B",BONNr,BLUNr)
 Quit
 ;
USERID(User) 
 New UserId,MailId,Txt
 Quit:$zcvt(User,"U")["AUTO" "" ; rechtstreekse uitvoer van autmatisch magazijn - PV 09-12-05
 Set UserId=$$USERID^vhUSER(User)
 If $L(User),'UserId Do
 .Set Txt=User_" is onbekend in ^vhUSER, gelieve hiervoor het nodige te doen."
 .Set MailId=$$SYSTEM^vhMAIL("","","Onbekende gebruiker","SYS",Txt,"","","A")
 Quit UserId
 ;
RAADPL(PRNr,Par,%J) 
 New R,Count,Delete,PRHIST,Magazijn,Beperk,HistNr,Input,DefBep,FysStock,WVStock,StockFlow,U4
 Set Menu=$G(Par("MENU"),"PRHIST"),Delete=0,R=$G(^PRSTOCK("D",PRNr)),FysStock=$P(R,D),WVStock=$P(R,D,5)
 If '$G(%J) Set %J=$$%J^vhRtn1(),Delete=1 Kill ^HULP(%J)
 Set Magazijn=$P($G(^KPR(PRNr,15)),D,11) Set:Magazijn="" Magazijn="M"
 Set (DefBep,Beperk)="M"_Magazijn_$S(Magazijn="M":";MZ;MK",1:"")
 Set:$D(^HULP(%J,"PAR","PRHIST","BEPERK")) Beperk=^HULP(%J,"PAR","PRHIST","BEPERK")
 Set ^HULP(%J,"PAR","PRHIST","BEPERK")=Beperk
 Set StockFlow=FysStock+$S(";"_Beperk_";"[";MW;":WVStock,1:0)
 If PRNr=$G(^HULP(%J,"PAR","PRHIST","PRNr")),$D(^HULP(%J,"PAR","PRHIST","LD")) Do
 .Merge PRHIST=^HULP(%J,"PAR","PRHIST","LD")
 .Kill ^HULP(%J,"PAR","PRHIST","LD")
 .Set Count=$$CBMORE(0,PRHIST("MAX"),PRNr_D_D_Beperk_D_StockFlow)
 Else  Do
 .Do INIT^vhLIST("PRHIST","LIJST",.PRHIST)
 .Set Count=$$CBMORE(0,$P(PRHIST("POS"),";",3)-$P(PRHIST("POS"),";")+1,PRNr_D_D_Beperk_D_StockFlow)
 Set U4="H" Do SA^RPLPR1
 Do WRITE^vhLIST(.PRHIST)
 For  Set Input=$$SCROLL^vhLIST(.PRHIST) Do  Quit:$L(Input)
 .If Input="COM" Set Input="" Do CALL^vhMenu(Menu)
 .If Input="SPEC" Set Input="" Do CALLSPEC^vhMenu(PRHIST("POS")+PRHIST("SELECT")_";80","PRHIST")
 .Do:$L(Input) EXEC^vhMenu(Menu,.Input)
 .Do:$L(Input) EXEC^vhMenu("PRHIST",.Input)
 .If Input'="REFRESH",%J'=$J
 .Else  Merge ^HULP(%J,"PAR","PRHIST","LD")=PRHIST Set ^HULP(%J,"PAR","PRHIST","PRNr")=PRNr
 If Delete Kill ^HULP(%J)
 Set:"\-\CANC\"[(D_Input_D) Input="-" Set Par("Input")=Input
 Quit
 ;
 ; Nieuwe selectiekriteria
SELECT   
 New R,zb,TempBep,FysStock,WVStock,StockFlow,U4
 Set TempBep=Beperk
 Set Beperk=$$PI^vhPOPUP("C;C","-OM1","Magazijn","PRHIST","BEPERK",Beperk)
 If zb'="CANC",Beperk="OH" Set Input="H"
 Else  If zb'="CANC",Beperk'=TempBep Do
 .Set R=$G(^PRSTOCK("D",PRNr)),FysStock=$P(R,D),WVStock=$P(R,D,5)
 .Set StockFlow=FysStock+$S(";"_Beperk_";"[";MW;":WVStock,1:0)
 .Kill ^HULP(%J,"P"_PRNr,"PRHIST")
 .Do INIT^vhLIST("PRHIST","LIJST",.PRHIST)
 .Set Count=$$CBMORE(0,$P(PRHIST("POS"),";",3)-$P(PRHIST("POS"),";")+1,PRNr_D_D_Beperk_D_StockFlow)
 .Set U4="H" Do SA^RPLPR1
 .Do WRITE^vhLIST(.PRHIST)
 Else  Set Beperk=TempBep
 Set ^HULP(%J,"PAR","PRHIST","BEPERK")=Beperk
 Quit
 ;
CBMORE(Max,Len,Rec) ; Om de historiek in stukjes op te halen    
 New I,PRNr,HistNr,Beperk,Stock
 Set PRNr=$P(Rec,D),HistNr=$P(Rec,D,2),Beperk=$P(Rec,D,3),Stock=$P(Rec,D,4)
 Set Len=Len+Max
 If PRNr For  Set HistNr=$O(^PRHIST(PRNr,HistNr),-1) Quit:HistNr=""  Do  Quit:Max'<Len
 .Set Rec=^PRHIST(PRNr,HistNr)
 .Quit:'$$INCLMAG(Rec,Beperk)
 .Quit:'$$INCLTRAC(Rec,Beperk)
 .Quit:'$$INCLCUST(Rec,Beperk)
 .Set $P(Rec,D,3)=Stock Set:$P(Rec,D,5)'="Z" Stock=Stock-$P(Rec,D,2)
 .Set Max=Max+1,^HULP(%J,"P"_PRNr,"PRHIST",Max)=PRNr_D_HistNr_D_Beperk_D_Stock
 .Set ^HULP(%J,"P"_PRNr,"PRHIST",Max,1)=Rec
 .Quit:$O(^PRHIST(PRNr,HistNr),-1)'=""
 Set:HistNr="" Max=-Max ; Alles gehad
 Quit Max
 ;
 ; Beperking op magazijn
INCLMAG(Rec,Beperk) 
 New I,R,Magazijn,Include
 For I=1:1:$L(Beperk,";") If $E($P(Beperk,";",I))'="M" Set $P(Beperk,";",I)=""
 If $L($TR(Beperk,";","")) Do
 .Set Include=0
 .For I=1:1:$L(Beperk,";")  Do  Quit:Include
 ..Quit:$P(Beperk,";",I)=""
 ..Set Magazijn=$E($P(Beperk,";",I),2)
 ..If $L(Magazijn),$P(Rec,D,5)=Magazijn Set Include=1
 Else  Set Include=1
 Quit Include
 ;
 ; Beperking op transactie
INCLTRAC(Rec,Beperk) 
 New I,R,TansAct,Include
 For I=1:1:$L(Beperk,";") If $E($P(Beperk,";",I))'="T" Set $P(Beperk,";",I)=""
 If $L($TR(Beperk,";","")) Do
 .Set Include=0
 .For I=1:1:$L(Beperk,";")  Do  Quit:Include
 ..Quit:$P(Beperk,";",I)=""
 ..Set TansAct=$E($P(Beperk,";",I),2)
 ..If $L(TansAct),$P(Rec,D,4)=TansAct Set Include=1
 Else  Set Include=1
 Quit Include
 ;
 ; Beperking op klant
INCLCUST(Rec,Beperk) 
 New I,R,KLNr,Include
 For I=1:1:$L(Beperk,";") If $P($P(Beperk,";",I),"#")'="BK" Set $P(Beperk,";",I)=""
 If $L($TR(Beperk,";","")) Do
 .Set Include=0
 .For I=1:1:$L(Beperk,";")  Do  Quit:Include
 ..Quit:$P(Beperk,";",I)=""
 ..Set KLNr=$P($P(Beperk,";",I),"#",2)
 ..If $L(KLNr),$P(Rec,D,6)=KLNr Set Include=1
 Else  Set Include=1
 Quit Include
 ;
 ; Call back  na de opbouw van sX en sY
CBBEPA(sY) 
 New D,I,R,Code,KLNr,sYTemp
 Set D="\",Code=""
 For I=1:1 Quit:'$D(sY(I))  Do  ; Invoegen van de saparators
 .Set R=sY(I) Set:Code="" Code=$P(R,"`")
 .Quit:$E(Code)=$E(R)  Quit:$E(R)="&"
 .For J=$O(sY(""),-1):-1:I Set sY(J+1)=sY(J)
 .Set Code=$P(R,"`"),sY(J)="&S&C"_$S($E(Code)="T":" Transactie ",1:"")
 Set sY=$O(sY(""),-1)
 Merge sYTemp=sY
 Kill sX
 For I=1:1 Quit:'$D(sY(I))  Do  ; sX terug opzetten
 .Set R=sY(I)
 .Set:";"_Beperk[(";"_$P($P(R,"`"),"#")) sX(I)=1
 .Quit:$P($P(R,"`"),"#")'="BK"  Quit:";"_Beperk'[";BK"
 .Set KLNr=$P($P(";"_Beperk,";BK#",2),";")
 .Quit:'KLNr
 .Set $P(R,"`")="BK#"_KLNr,$P(R,"`",2)=$P(R,"`",2)_" "_KLNr_" "_$P(^KKL(^KK1(KLNr),0),D,2),sY(I)=R
 Quit
 ;
 ; Call back voor de selectie van de beperk elementen
CBBEPS(sSelect,sOld,sNew,sRec) 
 New I,Code,Ok,KLNr,TransAct,sYTemp
 Set Code=$P($P(sRec,"`"),"#"),Ok=1
 Merge sYTemp=sY
 Do:sOld
 .Do:Code="BK"
 ..For I=1:1 Quit:'$D(sY(I))  Do
 ...Set R=sY(I)
 ...Quit:$P($P(R,"`"),"#")'="BK"
 ...Set $P(R,"`")="BK",$P(R,"`",2)=$P($P(R,"`",2)," ",1,2),sY(I)=R
 Do:sNew
 .Do:Code="BK"
 ..New D,zb
 ..Do STORE^vhTERMINA()
 ..Set D="\",KLNr=$$SELECT^KLANT6()
 ..Do REFRESH^vhTERMINA()
 ..If 'KLNr Set Ok=0 Quit
 ..For I=1:1 Quit:'$D(sY(I))  Do
 ...Set R=sY(I)
 ...Quit:$P($P(R,"`"),"#")'="BK"
 ...Set $P(R,"`")="BK#"_KLNr,$P(R,"`",2)=$P(R,"`",2)_" "_KLNr_" "_$P(^KKL(^KK1(KLNr),0),D,2),sY(I)=R
 .Do:Code="BS"
 ..Kill sX
 ..For I=1:1 Quit:'$D(sY(I))  Do
 ...Set R=sY(I)
 ...If ";"_DefBep_";"[(";"_$P($P(R,"`"),"#")_";") Set sX(I)=1 Quit
 ...Quit:$P($P(R,"`"),"#")'="BK"
 ...Set $P(R,"`")="BK",$P(R,"`",2)=$P($P(R,"`",2)," ",1,2),sY(I)=R
 Quit Ok
 ;
DETAIL(PRHIST) 
 New R,HISTDET,PRNr,HistNr,sFL
 Set R=$G(@(PRHIST("F"))@(PRHIST("SELECT"))),PRNr=$P(R,D),HistNr=$P(R,D,2)
 If PRNr,HistNr Do
 .Do STORE^vhTERMINA()
 .Do INIT^vhLIST("PRHIST","DETAIL",.HISTDET)
 .Set sFL(1)=@(HISTDET("F")),sFL(2)=@(PRHIST("F"))@(PRHIST("SELECT"),1)
 .Do WRITE^vhLIST(.HISTDET),DISPLAY^vhScherm("PRHISTDET",,,,,1)
 .For  Set R=$$SCROLL^vhLIST(.HISTDET) Quit:R="O"  Do
 ..Do REFRESH^vhTERMINA()
 ..Do MOVE^vhLIST(.PRHIST,$S(R=")":"DO",1:"UP"),1)
 ..Do STORE^vhTERMINA()
 ..Set R=@(PRHIST("F"))@(PRHIST("SELECT")),PRNr=$P(R,D),HistNr=$P(R,D,2)
 ..Do INIT^vhLIST("PRHIST","DETAIL",.HISTDET)
 ..Set sFL(1)=@(HISTDET("F")),sFL(2)=@(PRHIST("F"))@(PRHIST("SELECT"),1)
 ..Do WRITE^vhLIST(.HISTDET),DISPLAY^vhScherm("PRHISTDET",,,,,1)
 .Do REFRESH^vhTERMINA()
 Quit
 ;
OMSCHR(Rec) 
 New R,Omschr,KLNr,BONNr,FANr,TOENr
 Set Omschr=$P(Rec,D,11),KLNr=$P(Rec,D,6),TOENr=$P(Rec,D,7)
 If KLNr,"\U\T\H\R\"[(D_$P(Rec,D,4)_D) Do
 .Set Omschr=KLNr_" "_$P($G(^KKL($G(^KK1(KLNr),"*"),0)),D,2)
 .Quit:$P(Rec,D,4)'="U"
 .Set BONNr=$P(Rec,D,7)
 .Quit:'BONNr  Quit:$D(^KU1(BONNr))
 .If $ISVALIDNUM(BONNr,,200000,299999) Set Omschr=Omschr_" (DO)"
 .Else  Set FANr=$P(Rec,D,10) Set:'FANr Omschr=Omschr_" (STORNO)"
 Else  If KLNr,$P(Rec,D,4)="I" Do
 .Quit:$$LEVNR^PRODUKT2(PRNr)=KLNr  ; Leverancier van het produkt
 .If TOENr>199999,TOENr<300000 Quit
 .Quit:##class(Derde.Lev.Lev).LevAlsKlant(##class(Prod.Product).GetPropViaNr(PRNr,"LEVNr"))=KLNr ; Klant als leverancier
 .Quit:'$D(^KK1(KLNr))
 .Set Omschr=KLNr_" "_$P(^KKL(^KK1(KLNr),0),D,2)
 Set:$E(Omschr,$L(Omschr))="/" $E(Omschr,$L(Omschr))=""
 Quit Omschr
 ;
 ; Wijzigen aktie indien manuele correctie, rechtzetting invoer, rechtzetting uitvoer of optimalisatie
MODAKTIE(PRHIST) 
 New zb,R,PRNr,HistNr,HistRec,Aktie,ModAktie,OldAktie,Aantal
 Set ModAktie=1,R=@(PRHIST("F"))@(PRHIST("SELECT")),PRNr=$P(R,D),HistNr=$P(R,D,2)
 Set HistRec=^PRHIST(PRNr,HistNr)
 If $L($P(HistRec,D,4)),"#L#B#S#N#J#V#U#I#M#D#A#O#T#R#Q#C#W#"[("#"_$P(HistRec,D,4)_"#") Do
 . Set Aktie=$$PI^vhPOPUP("C;C","-O1","Aktie","PRHIST","BEPERK","")
 . Quit:$G(zb)="CANC"  Quit:Aktie=""  Quit:Aktie=$P(HistRec,D,4)
 . Set OldAktie=$P(HistRec,D,4)
 . Set Aktie=$E(Aktie,2),$P(HistRec,D,4)=Aktie,^PRHIST(PRNr,HistNr)=HistRec
 . If Aktie="J"!(OldAktie="J") Set Aantal=$P(HistRec,D,2) Set:OldAktie="J" Aantal=-Aantal Do MODRECUPAK(PRNr,Aantal,Aktie)
 . Set $P(@(PRHIST("F"))@(PRHIST("SELECT"),1),D,4)=Aktie
 . Do LINE^vhLIST(.PRHIST,PRHIST("SELECT"))
 Quit
 ;
 ; Wijzigen recupacks
MODRECUPAK(PRNr,Aantal,Aktie)
 New %SC,J,R,RecuPakPRNr,RecuPakAantal,StPerRecuPak
 Set J=$O(^KPR(PRNr,"J"))
 Do:$E(J)="J"
 . Set R=^KPR(PRNr,J),RecuPakPRNr=$P(R,D,32),StPerRecuPak=$P(R,D,33)
 . Quit:'RecuPakPRNr  Quit:'StPerRecuPak
 . Set RecuPakAantal=Aantal/StPerRecuPak
 . Set:Aantal>0 RecuPakAantal=RecuPakAantal+.9 Set:Aantal<0 RecuPakAantal=RecuPakAantal-.9
 . Set RecuPakAantal=RecuPakAantal\1
 . Do STORE^vhTERMINA()
 . Do DISPLAY^vhScherm("PRHISTRECU")
 . Do FIELD^vhScherm("PRHISTRECU","RECUAANTAL")
 . Do:%SC PUT(RecuPakPRNr,RecuPakAantal,Aktie)
 . Do REFRESH^vhTERMINA()
 . Do MODRECUPAK(RecuPakPRNr,RecuPakAantal,Aktie) ; Recursief voor opzetranden
 Quit
 ;
 ; Wijzigen omschrijving op alle wijzigingen behalve de std inboekingen (T,I,U,H)
MODOMSCHR(PRHIST) 
 New R,PRNr,HistNr,HistRec,Omschr
 Set R=@(PRHIST("F"))@(PRHIST("SELECT")),PRNr=$P(R,D),HistNr=$P(R,D,2)
 Set HistRec=^PRHIST(PRNr,HistNr)
 If $L($P(HistRec,D,4)),"#U#I#T#H#"'[("#"_$P(HistRec,D,4)_"#") Do
 . Do STORE^vhTERMINA()
 . Set Omschr=$P(HistRec,D,11),Omschr=$$ASKL^vhINP("PRHIST","MODOMSCHR")
 . Do REFRESH^vhTERMINA()
 . If Omschr'="-",Omschr'=".",Omschr'=",",Omschr'=$P(HistRec,D,11)
 . Else  Quit
 . Set $P(HistRec,D,11)=Omschr,^PRHIST(PRNr,HistNr)=HistRec
 . Set $P(@(PRHIST("F"))@(PRHIST("SELECT"),1),D,11)=Omschr
 . Do LINE^vhLIST(.PRHIST,PRHIST("SELECT"))
 Quit
 ;
 ; Call back voor het inserten van items in de popup MODAKTIE
CBMODA(Item)
 New R,Aktie,Insert
 Set Insert=0,Item=$E($P(Item,"`"),2)
 Set Aktie=$P(@(PRHIST("F"))@(PRHIST("SELECT"),1),"\",4)
 If Item="B","#M#D#A#L#Q#C#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="C","#M#D#A#L#Q#B#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="L","#M#D#A#B#Q#C#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="S","#M#D#N#A#Q#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="N",Aktie="M" Set Insert=1
 If Item="J","#M#D#N#S#B#L#I#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="V","#M#D#N#S#B#L#U#Q#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="Q","#M#D#N#S#B#L#R#C#V#"[("#"_Aktie_"#") Set Insert=1
 If Item="U",Aktie="V" Set Insert=1
 If Item="I",Aktie="J" Set Insert=1
 If Item="R","#Q#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="E","#M#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="M","#D#T#B#L#S#N#A#O#E#I#J#R#Q#I#J#C#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="D","#M#T#B#L#S#N#A#O#E#I#J#R#Q#I#J#C#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="A","#T#B#L#S#N#M#D#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="O","#M#D#W#"[("#"_Aktie_"#") Set Insert=1
 If Item="W","#M#A#J#V#O#B#S#R#D#L#C#"[("#"_Aktie_"#") Set Insert=1
 ; Item="X" zijn verwijderde lijnen (STORNO)
 Quit Insert
 ;
 ;Set KLNr=##class(Derde.Lev.Lev).LevAlsKlant(##class(Prod.Product).GetPropViaNr(PRNr,"LEVNr")) ; Klant als leverancier
 ;
PRINT(%J,PRNr,PRHIST) 
 New R,Dev,PRHIST,Count,FysStock,WVStock,StockFlow
 Do STORE^vhTERMINA()
 Set R=$G(^PRSTOCK("D",PRNr)),FysStock=$P(R,D),WVStock=$P(R,D,5)
 Kill ^HULP(%J,"P"_PRNr,"PRHIST")
 Do INIT^vhLISTO("PRHIST","LIJST",.PRHIST)
 Set PRHIST(11)=PRHIST(11)_D_$P(^KPR(PRNr,0),D)
 Set StockFlow=FysStock+$S(";"_Beperk_";"[";MW;":WVStock,1:0)
 Set Count=$$CBMORE(0,99999,PRNr_D_D_Beperk_D_StockFlow)
 Do PRINT^OUTPUT(.PRHIST,"PT")
 Do REFRESH^vhTERMINA()
 Quit
 ;
 ; Call back formatering
CBFMT(Ref,Rec) 
 If $D(Rec) Set sFL(2)=@($ZR)@(1),sFmt=$S($P(sRec,D)="&S":sRec,1:sFmt) Quit sFmt
 Else  Set R=@sQNext
 If $P(R,D)=PRNr Quit "SK"
 Else  Set (FL(3,2),sFL(2))=R Quit ""
 ;
 ; Valideren van een Menu-item
CHKITEM(Item) 
 New R,AddItem,KLNr,MPRNr
 Set AddItem=0
 If Item="KLANT" Do
 .If $D(^HULP(%J,"P"_PRNr,"PRHIST",PRHIST("SELECT"))) Do
 ..Set R=^HULP(%J,"P"_PRNr,"PRHIST",PRHIST("SELECT"),1)
 ..Set:"\U\T\H\R\Q\V\"[(D_$P(R,D,4)_D) KLNr=$P(R,D,6)
 .If $G(KLNr),$D(^KK1(KLNr)) Set AddItem=1
 If Item="MOEDER" Do
 .If $D(^HULP(%J,"P"_PRNr,"PRHIST",PRHIST("SELECT"))) Do
 ..Set R=^HULP(%J,"P"_PRNr,"PRHIST",PRHIST("SELECT"),1),MPRNr=$P(R,D,15)
 .If $G(MPRNr),$D(^KPR(MPRNr)) Set AddItem=1
 Quit AddItem
 ;
 ; Is er een klacht verbonden aan deze bon, factuur en dit product
KLACHTID(PRNr,HistRec)
 New Klacht,Count,KLNr,BONNr,FANr
 Set HistRec=$G(HistRec),Klacht=""
 Set KLNr=$P(HistRec,D,6),BONNr=$P(HistRec,D,7),FANr=$P(HistRec,D,10),Count=0
 If KLNr,"\U\"[(D_$P(HistRec,D,4)_D) Do
 . Set Count=Count+1,Klacht(Count)="P\"_PRNr
 . Set Count=Count+1,Klacht(Count)="K\"_KLNr
 . Set:BONNr Count=Count+1,Klacht(Count)="B\"_BONNr
 . Set:FANr Count=Count+1,Klacht(Count)=$S($D(^KFA("F",FANr)):"F",1:"V")_D_FANr
 . Do KLACHTID^KLACHTS(.Klacht)
 Quit Klacht
 ;
 ; Is er een receptie verbonden aan deze lijn en bestaat deze nog?
RCPNR(HistRec)
 New RCPNr
 If "\I\"[(D_$P(HistRec,D,4)_D) Do
 . Set RCPNr=$P(HistRec,D,10)
 . Quit:'RCPNr
 . Set:'$D(^RCP("D",RCPNr)) RCPNr=""
 Quit $G(RCPNr)
 ;
 ; Is er een consolidatie verbonden aan deze lijn en bestaat deze nog?
CONSNR(HistRec)
 New CONSNr
 If "\U\"[(D_$P(HistRec,D,4)_D) Do
 . Set CONSNr=$P(HistRec,D,7)
 . Quit:'CONSNr
 . Set:'$D(^ORDW("D",CONSNr)) CONSNr=""
 Quit $G(CONSNr)
 ;