#Include BL.Derde.Kennis.AutoRes
#include BL.Derde.KlantSpecifiek
 
RPLMBON ;Raadplegen MoederBon [ 11/04/2003  1:58 PM ]
 Q 
 ;
 ;Verkoopanalyze Moederbon
VERWERK 
 New %TC,VHisie,KsCust,LogNr,InGebruik,BeperkDatum,Versie
 Do BeperkDatum(KC)
 Set VHisie=$P($G(^MBLOG("D",$$IO^cQ5,KC)),D,3)["VHISIE",KsCust=$$IsKSKlant(KC)
 S DL(1)="VMB",VMB(1)="^HULP("_$J_",""K"_KC_""",""VM""," Kill Refetch
 G LOCK:VTB=U4&(KC=KCX) D KIF^RPLKL1,SA^RPLKL1
 I $O(^HULP($J,"K"_KC,"VM","")) D SHOW G LOCK
VMB1 D SA1^RPLKL1,FETCH,SA^RPLKL1
 ; Command loop
LOCK
 Do ADD^vhLock("^MBLOG(""D"",$$IO^cQ5,KC)")
 If '%TC Do LDISP^vhLock("^MBLOG(""D"",$$IO^cQ5,KC)","Moederbon") Set R=$G(VTB) Set:R="" R=1 Set VTB=U4,SW2=0 Quit
INGEBRUIK
 Set LogNr=""
 For  Set LogNr=$O(^MBLOG("OI",KC,LogNr)) Quit:LogNr=""  Set InGebruik=$$INGEBRUIK^MOEDERB(KC,LogNr)=io Quit:InGebruik
 Quit:$G(InGebruik)
COMMAND
 Do SL^PROC Set VTB=U4,SW2=0
 If R="SPEC" Do
 .New Input
 .Quit:'$D(DL)
 .Do CALLSPEC^vhMenu(@DL(1)@(3)+@DL(1)@(6)-1_";80","RPLMBSPEC","")
 .Set R=$G(Input)
 Set Input=R
 Do EXEC^vhMenu("RPLMBSPEC",.Input)
 Set R=$G(Input)
 If "\PRINT\FAX\X\N\ENTER\ASK\V\C\KST\"[(D_R_D),sScr("VTW") Goto COMMAND
 If "\PRINT\FAX\X\N\ENTER\ASK\V\C\KST\"[(D_R_D),$P(^KKL(^KK1(KC),2),D,10) Set R=$$^vhTXTPOP("RPLKL","NONAKTIEF") Goto COMMAND
 If R="PRINT" D PRINT G COMMAND
 If R="FAX" D FAX G COMMAND
 If R="EDI" D EDI
 If R="X" Do DELALL,REFRESH^RPLKL,SHOW,SA^RPLKL1 G COMMAND:'$G(VHisie) Set R="-"
 If R="N" Do NIEUW G COMMAND
 If R="ENTER"!(R="ASK"),$D(^HULP($J,"K"_KC,"VM",VMB(6))) Do ASK($P(^HULP($J,"K"_KC,"VM",VMB(6)),D,15)),UNLOCK Quit
 If R="V",$D(^HULP($J,"K"_KC,"VM",VMB(6))) D DELETE,UNLOCK Quit
 If R="C",$D(^HULP($J,"K"_KC,"VM",VMB(6))) D PAKKET,UNLOCK Quit
 If R="KST",$D(^HULP($J,"K"_KC,"VM",VMB(6))) Do KST,UNLOCK Quit
 Do UNLOCK
 Quit
 
UNLOCK
 Do REMOVE^vhLock("^MBLOG(""D"",$$IO^cQ5,KC)")
 Quit
 
IsKSKlant(KLNr)
 	New KlantID
 	#dim KlantID As DOM.VKP.VanHoeckeKlantID = ##class(DOM.DomeinContext).Instance().GeefLegacyPartijAPI().GeefKlantPartijID(KLNr)
	Quit '(##class(DOM.DomeinContext).Instance().GeefKlantTypeAPI().IsIndustriePoolKlant(KlantID))
 
 ;Wordt uitgevoerd door CareTaker
RESET D ^cA604
 Set $ZT="ERR^cA406"
 Kill:$O(^MBLOG("A",""))="" ^MBLOG("AN")
 Kill ^MBLOG("D"),^MBLOG("N")
 Set (KLNr,VolgNr)=""
 For  Set KLNr=$O(^MBLOG("T",KLNr)) Quit:KLNr=""  Do
 .For  Set VolgNr=$O(^MBLOG("T",KLNr,VolgNr)) Quit:VolgNr=""  Do
 ..Quit:$H-30<+$P(^MBLOG("T",KLNr,VolgNr),D)
 ..; Transfer meer dan 30 dagen oud
 ..Kill ^MBLOG("T",KLNr,VolgNr)
 Set ^MBLOG("OD",^KOD(0,"F","UR"))=+$H
 Quit
 
PAKKET ; Opvragen van een pakket
 Set PRNr=$P(^HULP($J,"K"_KC,"VM",VMB(6)),D,15)
 Set PAKNr=$$SELECT^PAKKETS(KC,PRNr,"",1)
 Goto PAKKET2:'PAKNr
 Do VERWPAK(PAKNr,0)
 Quit
 
VERWPAK(PAKNr,Extern) ; Markeren van een pakket
 New Imp,I,OldFak,Faktor,KsCust
 Set KsCust=$$IsKSKlant(KC),Imp=""
 If $P(^PAKKET("D",PAKNr),D,3)'="D" Do  Goto:'Extern PAKKET Quit:Extern  ; Geen divergent pakket
 .Set FP=2101
 .Write @F,@F1
 .Do ASK($O(^PAKKET("D",PAKNr,"")))
 Set OldFak=$G(^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr))
 Set Faktor=$$ASKL^vhINP("RPLKL","VMBPAKKET")
 Goto PAKKET2:Faktor="-"!(OldFak=""&'Faktor)
 If OldFak Do
 .Set ^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr)=Faktor
 .Set PRNr=""
 .For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr,PRNr)) Quit:'PRNr  Do
 ..Set OldVal=^(PRNr),NewVal=OldVal*Faktor/OldFak
 ..Set ^(PRNr)=NewVal
 ..Set $P(^MBLOG("D",$$IO^cQ5,KC,PRNr),D,2)=NewVal-OldVal+$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D,2)
 Else  Do
 .Do MARKLOG(KC)
 .Do IMPORT^PAKKETS(.Imp,PAKNr,Faktor)
 .Set ^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr)=Faktor
 .Set PRNr=""
 .For I=1:1:$P(Imp,D,5) Do
 ..Quit:$P(Imp(I),D)'="P"
 ..Set PRNr=$P(Imp(I),D,2)
 ..Set ^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr,PRNr)=$P(Imp(I),D,3)
 ..Set $P(^MBLOG("D",$$IO^cQ5,KC,PRNr),D,2)=$P(Imp(I),D,3)+$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D,2)
 ..Do:'Extern!$D(^HULP($J,"K"_KC,"VM")) ADD(PRNr,0)
PAKKET2 Quit:$G(Extern)
 Set FP=2401 Write @F,@F1
 New DL Set DL(1)="VMB",DL(2)=VMB(3),DL(3)=23 Do WL^PROC
 Q
 
DELETE Set PRNr=$P(^HULP($J,"K"_KC,"VM",VMB(6)),D,15)
 New MirrorPRNr
 If PRNr,$D(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Do
 .Set $P(^(PRNr),D,1)=""
 .Kill:'$P(^(PRNr),D,2) ^(PRNr)
 .Set MirrorPRNr=$$GetMirror^PRODUKT(PRNr)
 .If MirrorPRNr,$D(^MBLOG("D",$$IO^cQ5,KC,MirrorPRNr)),$$DelMirror^PRODUKT(PRNr) Do  Quit
 ..Kill ^MBLOG("D",$$IO^cQ5,KC,MirrorPRNr)
 ..Do WL^PROC
 .;Set:$$ISKLPR^KS(KC,PRNr) $P(^HULP($J,"K"_KC,"VM",VMB(6)),D,9)=""
 .Set ^HULP($J,"K"_KC,"VM",VMB(6))=^HULP($J,"K"_KC,"VMO",VMB(6))
 .Do EL^PROC
 If $D(^MBLOG("D",$$IO^cQ5,KC))'>10 Kill ^(KC)
 Quit
 
DELALL 
 New Fax,TxtLoc,ButLoc,Count,Par
 Set Fax=$$CHECKFAX(KC)
 Set TxtLoc="TxtLoc",ButLoc="ButLoc",Count=1
 Set TxtLoc(Count)=$S(Fax<2:"Transfer naar order en/of",1:"De ")
 Set:Fax<2 Count=Count+1,TxtLoc(Count)=""
 Set TxtLoc(Count)=TxtLoc(Count)_"markering op produkten verwijderen"
 Set Count=1
 Set ButLoc(Count)="A=Annuleer",Count=Count+1,ButLoc(Count)="V=Verwijderen&V"
 If Fax<2 Do
 .Set Count=Count+1,ButLoc(Count)="T=Transfer+verwijder&T"
 .Set Count=Count+1,ButLoc(Count)="C=Transfer+copy&C"
 .Set Count=Count+1,ButLoc(Count)="O=Print+Opmaken order+verwijder&O"
 Set R=$$WILD^vhTXTPOP("","",.TxtLoc,.ButLoc,1,15)
 If Fax=2,$L(R),"TC"[R Set R=""
 If $L(R),"VTCO"[R Do
 .If R="O" Do  Quit:R=""
 ..Set R=$$CHECKORD(KC)
 ..Do:R["P" PRINT
 ..Set R=$TR(R,"P","")
 .Do:"O"[R ORDER(KC)
 .Do:"TC"[R TRANSFER
 .Kill:"TVO"[R ^MBLOG("D",$$IO^cQ5,KC),^HULP($J,"K"_KC,"VM"),^("VMI"),^("VMO"),^("VMBEP"),^("VMIBEP"),^("VMOBEP"),^("VMTOT"),^("VMITOT"),^("VMOTOT"),^HULP($J,"PAR","VM")
 .If "C"[R,$D(^MBLOG("D",$$IO^cQ5,KC))'<10 Do MARKLOG2
 .Kill Refetch,Versie
 .Do BeperkDatum(KC)
 .Set Versie=$P($G(^HULP($J,"PAR","VM","K")),D,2)
 .Set @DL(1)@(6)=1,@DL(1)@(7)=1
 .Do FETCH
 Else  New DL Set DL(1)="VMB",DL(2)=22,DL(3)=24 Do WL^PROC
 Set FP=2401 Write @F,@F1
 Quit
 
TRANSFER 
 New R,VMB,DL,MBLog,I1,I2,InitNm,IPNr,VerkPr,Korting,Taal,PakketBegin,PakketEinde
 Quit:$D(^MBLOG("D",$$IO^cQ5,KC))<10
 Kill ^HULP($J,"K"_KC,"VP")
 Set Taal=$P(^KKL(^KK1(KC),0),D,9)
 Set (PAKNr,PRNr)=""
 For  Set PAKNr=$O(^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr)) Quit:'PAKNr  Do
 .Set PakQty=^(PAKNr)
 .Set Pak=$G(^PAKKET("D",PAKNr)) Quit:'$L(Pak)
 .If $P(Pak,D,3)'="D" Quit
 .Set Key="A"_$$UPTRIMAN^vhRtn1($P(Pak,D,2))_" "
 .Set R=$P(Pak,D,2),PakketEinde=$S(Taal="F":"Fin",Taal="D":"Ende",Taal="E":"End",1:"Einde")_" "_R
 .Set PakketBegin=$J("",$L(PakketEinde)-$L(R)\2)_R,PakketBegin=PakketBegin_$J("",$L(PakketEinde)-$L(PakketBegin))
 .Set PakketBegin="** "_PakketBegin_" **",PakketEinde="** "_PakketEinde_" **"
 .Set ^HULP($J,"K"_KC,"VP",Key)="T"_D_PakketBegin_"\\\\\"_PAKNr_D
 .For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr,PRNr)) Quit:'PRNr  Do
 ..Set Qty=^(PRNr)
 ..Do TRANSP(PRNr,Key,Qty,,,PAKNr)
 .Set ^HULP($J,"K"_KC,"VP",Key_"~")="T"_D_PakketEinde_"\\\\\"_PAKNr_D
 Set PRNr="",Key="~ "
 For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Quit:'PRNr  Do
 .Set Qty=$P(^(PRNr),D),VerkPr=$P(^(PRNr),D,3),Korting=$P(^(PRNr),D,4)
 .Quit:'Qty&$P(^(PRNr),D,2)
 .Do TRANSP(PRNr,Key,Qty,VerkPr,Korting,"")
 Set LogNr=$P(^MBLOG("D",$$IO^cQ5,KC),D)
 Kill ^MBLOG("T",KC,LogNr)
 Set InitNm=$$IO^cQ5
 Set IPNr=$P($$DEVUSER^vhUSER($$IO^cQ5),";")
 If IPNr,$D(^vhUSER("D",IPNr)) Set InitNm=$P(^vhUSER("D",IPNr),D,4)
 Set ^MBLOG("T",KC,LogNr)=$H_D_InitNm_D_$P(^MBLOG("D",$$IO^cQ5,KC),D,3,4)_D_D_D_$P(^(KC),D,7,13)
 Set $P(^MBLOG("T",KC,LogNr),D,5)=$$IO^cQ5
 Set:$D(^MBLOG("D",$$IO^cQ5,KC,"LEVADR")) ^MBLOG("T",KC,LogNr,"LEVADR")=^MBLOG("D",$$IO^cQ5,KC,"LEVADR")
 Set (Key,Cnt)=""
 For  Set Key=$O(^HULP($J,"K"_KC,"VP",Key)) Quit:Key=""  Do
 .Set Rec=^(Key)
 .If Cnt,$P(^MBLOG("T",KC,LogNr,Cnt),D,1)="T",'$P(^MBLOG("T",KC,LogNr,Cnt),D,7),$P(Rec,D,1)="T" Set Cnt=Cnt-1
 .Set Cnt=Cnt+1
 .Set ^MBLOG("T",KC,LogNr,Cnt)=Rec
 If $P(^MBLOG("T",KC,LogNr,Cnt),D,1)="T",'$P(^MBLOG("T",KC,LogNr,Cnt),D,7) Kill ^(Cnt)
 Kill ^HULP($J,"K"_KC,"VP")
 Quit
 ; Opslaan van 1 produkt
TRANSP(PRNr,Key,Qty,VerkPr,Korting,KlantRef) 
 New B
 Do FETCHPR^UTILI(PRNr) Quit:'$D(B)
 Set Stock=$P(B(2),D,20)
 Set Rec=PRNr_D_$P(B(1),D)_D_$P(B(3),D,25)_D_Stock_D_$$GETSTOCK^PRODUKT4(PRNr,"F")
 Set Key=Key_$P(B("I"),D,3)_$$COMPR^PRODUKT(PRNr)
 Set ^HULP($J,"K"_KC,"VP",Key_" ")="P"_D_PRNr_D_Qty_D_$G(VerkPr)_D_$G(Korting)_D_D_KlantRef_D
 Quit
 
NIEUW New PRNr,NewProd
 Set PRNr=$$SELECT^PRODUKT6("","","","","NODO;NOKP",,,,KC,1)
 If PRNr Do
 .New VervangProd,Mirror
 .Set PRNr=$$CheckVervangProduct^FLOWPROD(PRNr,KC,.VervangProd)
 .If 'PRNr,$G(VervangProd) Set PRNr=$P(VervangProd,";") Set:$P(VervangProd,";",2) Mirror=$P(VervangProd,";",2)
 .Quit:'PRNr
 .Quit:$E($P(^KPR(PRNr,2),D,25))=7  Quit:'$$IsCommAkt^PRODUKT2(PRNr,KC)
 .If $P($G(^KSTKL(KC,PRNr,0)),D,11) Quit:'$$^vhTXTPOP("RPLMBON","NOMOEDERBON",,$P(^KPR(PRNr,0),D))
 .Set FP=1901 Write @F,@F1,!!!,"Produkt : ",$P(^KPR(PRNr,0),D,1)
 .Set NewProd=1
 .Do ASK(.PRNr,1,.Mirror)
 .Do ADD(PRNr,1)
 Set FP=2401 Write @F,@F1
 New DL Set DL(1)="VMB",DL(2)=19,DL(3)=24 Do WL^PROC
 Quit
 
 ; IsCommAkt = 1 (de test is op een hoger niveau uitgevoerd)
ASK(PRNr,IsCommAkt,Mirror) 
 New %R,%C,prompt,ln,X,Aantal,Quit,sAftPrmp
 New IsStock,PerStuk,GrootVp,NormVp,KleinVp
 New Grens,OnderGr,BovenGr,Korting,MirrorPRNr,Aantal,Proc
 Set R=##class(CHUI.Derde.Kennis.Kennis).KlantProductUnRead(KC,PRNr,$LB($$$adOrderVerwerkingIngave),1) Quit:R="ANNULEER"
 Do STORE^vhTERMINA()
 Set R="",FP=2401 Write @F,@F1
 Quit:'PRNr  Quit:'$D(^KPR(PRNr))  Quit:$E($P(^KPR(PRNr,2),D,25))=7
 If '$G(IsCommAkt) Quit:'$$IsCommAkt^PRODUKT2(PRNr,KC)
 Set IsToevoegingSpiegelProduct = $D(Mirror)
 Set R=$$CHKSOPR^FLOW(KC,PRNr,"moederbon",IsToevoegingSpiegelProduct)
 Quit:'R
 If R>999 Set PRNr=R,FP=2101 Write @F,@F1,!,"Produkt : ",$P(^KPR(PRNr,0),D,1)
 Set R=""
 
 For  Do  Quit:X'?.N  If X Quit:$$CHKAANT^FLOW(KC,PRNr,X)
 .Set X=$P(^KPR(PRNr,0),D,23) 
 .If X="K",KC'=$$$KlantHalux Set X=$P(^KPR(PRNr,0),D),X=$$^vhTXTPOP("FLOWORD","VERKKIND","",X) If 'X Set X="-" Quit
 .If $E(X)="H",KC'=$$$KlantHalux Set X=$P(^KPR(PRNr,0),D),X=$$^vhTXTPOP("FLOWORD","VERKHALFFABR","",X) If 'X Set X="-" Quit
 .Set %R=24,%C=1,prompt="Aantal stuks : ",ln=6,sAftPrmp=$$AfterPromptAantal(KC,PRNr)
 .Set X=$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D)
 .Do ^vhINP
 .If X?.N,'$E(X) Set X=0
 If X Do
 .Set R=^KPR(PRNr,1),IsStock=$P(R,D,20)
 .Set R=$O(^KPR(PRNr,"J")) Set:$E(R)="J" R=^KPR(PRNr,R)
 .Set PerStuk=$P(R,D,13),KleinVp=$P(R,D,14),NormVp=$P(R,D,15),GrootVp=$P(R,D,16) 
 .Set:'NormVp NormVp=GrootVp Set:'KleinVp KleinVp=NormVp
 .Quit:PerStuk=1  Quit:'(X#GrootVp)
 .If IsStock Quit:'(X#GrootVp#NormVp)  Set Grens=X#GrootVp#NormVp#KleinVp Quit:'Grens
 .Else  Set Grens=X#GrootVp
 .If Grens,PerStuk=-1 Quit:$$WWNooitPerStuk^FLOW2(PRNr)  Set X="-" Quit
 .Set OnderGr=X-Grens,BovenGr=OnderGr+KleinVp
 .If OnderGr!BovenGr Do
 ..Set Aantal=X
 ..For  Do  Quit:X'?.N  Quit:$$CHKAANT^FLOW(KC,PRNr,X)
 ...Set %R=24,%C=1,prompt="Aantal stuks "
 ...Set prompt=prompt_"(" Set:OnderGr prompt=prompt_"ondergrens "_OnderGr
 ...Set:OnderGr&BovenGr prompt=prompt_" - " Set:BovenGr prompt=prompt_"bovengrens "_BovenGr
 ...Set prompt=prompt_") : ",ln=6,X=Aantal
 ...Do ^vhINP
 Set FP=2401 Write @F,@F1
 If X?.N,X'=$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D) Do
 .Do MARKLOG(KC)
 .Set $P(^MBLOG("D",$$IO^cQ5,KC,PRNr),D)=X
 .If '$G(NewProd) Do
 ..New R,VNR
 ..Do:$P($G(^HULP($J,"K"_KC,"VM",VMB(6))),D,15)=PRNr MODPRIJS("^HULP($J,""K""_KC,""VM"",VMB(6))")
 ..Quit:$G(^HULP($J,"K"_KC,"VMIBEP",PRNr))
 ..; Indien nog niet in beperkte- maar wel in totale lijst dan invullen
 ..Set VNR=$G(^HULP($J,"K"_KC,"VMITOT",PRNr))
 ..Quit:'VNR
 ..Set R=^HULP($J,"K"_KC,"VMTOT",VNR),VNR=$O(^HULP($J,"K"_KC,"VMBEP",""),-1)+1
 ..Set ^HULP($J,"K"_KC,"VMBEP",VNR)=R,^HULP($J,"K"_KC,"VMIBEP",PRNr)=VNR
 .If $G(Mirror) Set:'$P(Mirror,"#",2) $P(Mirror,"#",2)=X
 .Else  Do
 ..Set MirrorPRNr=$$GetMirror^PRODUKT(PRNr)
 ..If MirrorPRNr Xecute "Set Mirror=$$"_$S($D(^MBLOG("D",$$IO^cQ5,KC,MirrorPRNr)):"Mod",1:"Add")_"Mirror^PRODUKT(PRNr,X)"
 ..Else  Set Mirror=""
 .Quit:'Mirror
 .Set MirrorPRNr=$P(Mirror,"#"),Aantal=$P(Mirror,"#",2)
 .Set $P(^MBLOG("D",$$IO^cQ5,KC,MirrorPRNr),D)=Aantal,Proc="WL"
 .Do:'$D(^HULP($J,"K"_KC,"VMI",MirrorPRNr)) ADD(MirrorPRNr,1)
 .Quit:$G(^HULP($J,"K"_KC,"VMIBEP",MirrorPRNr))
 .; Indien nog niet in beperkte- maar wel in totale lijst dan invullen
 .Set VNR=$G(^HULP($J,"K"_KC,"VMITOT",MirrorPRNr))
 .Quit:'VNR
 .Set R=^HULP($J,"K"_KC,"VMTOT",VNR),VNR=$O(^HULP($J,"K"_KC,"VMBEP",""),-1)+1
 .Set ^HULP($J,"K"_KC,"VMBEP",VNR)=R,^HULP($J,"K"_KC,"VMIBEP",MirrorPRNr)=VNR
 Do REFRESH^vhTERMINA()
 Do @($G(Proc,"EL")_"^PROC") ; Indien een lijn, dan EL^PROC. Indien meerdere lijnen (mirrorring), dan WL^PROC.
 Quit
 
 ; Zal een lijn eventueel moeten verschoven worden naar later?
AfterPromptAantal(KLNr,PRNr)
 New AfterPrompt,VerzendWijze,LandCode,PostCode,MagOpschuiven,blVerzendWijze,blLeveringsTermijn,VroegsteLeverDag
 If '$$MagazijnBeschikbaarVoorProduct^EWORDSM(PRNr,,,1) Do  ; Het magazijn voor dit product is niet beschikbaar voor automatisch doorsturen
 .Set VerzendWijze=$$DEFAULT^KLVERZW(,KLNr)
 .Set LandCode=$$LAND^vhRtn1(KLNr,"K")
 .Set PostCode=$P(^KKL(^KK1(KLNr),0),D,6)
 .Set blVerzendWijze=##class(APPS.VKP.VerzendWijze).%New(KLNr,VerzendWijze,LandCode,PostCode)
 .Set blLeveringsTermijn=##class(APPS.VKP.LeveringsTermijn).%New($H,blVerzendWijze)
 .Set VroegsteLeverDag=$$GetLeverDag^FLOW3(KLNr,PRNr,,1)
 .Quit:VroegsteLeverDag>$$CALCDATE^vhLib.DataTypes(,"A",1)  ; Is voor levering na volgende arbeidsdag
 .Set MagOpschuiven=blVerzendWijze.MagOpschuivenIndienAutoSendAf()
 .Set:MagOpschuiven AfterPrompt=" Levertermijn D+2 wegens stop op automatisch magazijn"
 Quit $G(AfterPrompt)
 
KST 
 New %R,%C,prompt,ln,R,X,PRNr,HPrijs,Korting
 Set R=^HULP($J,"K"_KC,"VM",VMB(6)),PRNr=$P(R,D,15),HPrijs=$P(R,D,9)
 Do STORE^vhTERMINA()
 Set R="",FP=2401 Write @F,@F1
 Quit:'PRNr  Quit:'$D(^KPR(PRNr))  Quit:$E($P(^KPR(PRNr,2),D,25))=7  Quit:'$$IsCommAkt^PRODUKT2(PRNr,KC)
 If $$IsKSKlant(KC),'$$ISPROD^KS(PRNr)
 Else  Quit
 For  Do  Quit:X="-"
 .Set X=$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D,3) S:'X X=HPrijs
 .Set X=$$ASK^vhINP("Verkoopprijs : ",6,X,"K[], S[] of kort%","",1,"","","E")
 .If X="K"!(X="S") Set X=$S(X="S":"E",1:X),R=$$KSKORT^KPRIJS(PRNr,X) S:'R R=$$KSKORT^KPRIJS(,X) S:R X=R_"%"
 .If X'?.N,X'?.N1"."1N,X'?.N1"."2N,$E(X,$L(X))'="%" Quit
 .If X["%" Do
 ..Set X=+X
 ..If X'?.N,X'?.N1"."1N,X'?1"-".N,X'?1"-".N1"."1N Set X="" Quit
 ..Set Korting=X,X=$J(HPrijs*(100-Korting)/100,0,2)
 .Quit:X=""
 .Set FP=2401 Write @F,@F1
 .Do MARKLOG(KC)
 .Do
 ..If X'?.N,X'?.N1"."1N,X'?.N1"."2N Quit
 ..Quit:X=$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D,3)
 ..Set:'$D(Korting) Korting=$J(100-(X/HPrijs*100),0,1)
 ..Set $P(^MBLOG("D",$$IO^cQ5,KC,PRNr),D,3,4)=$S(Korting:X_D_Korting,1:D)
 ..Set $P(^HULP($J,"K"_KC,"VM",VMB(6)),D,51)=$S(+X=+$P(^HULP($J,"K"_KC,"VM",VMB(6)),D,9):"",1:X)
 .Set X="-"
 Do REFRESH^vhTERMINA()
 Do EL^PROC
 Quit
 
MARKLOG(KC) 
 Quit:$D(^MBLOG("D",$$IO^cQ5,KC))#10
MARKLOG2 Lock +^MBLOG("N")
 Set ^MBLOG("N")=$G(^MBLOG("N"))+1
 Set ^MBLOG("D",$$IO^cQ5,KC)=^MBLOG("N")
 Lock -^MBLOG("N")
 Quit
 
 
FETCH 
 New PRNr,MBList,VNR,VNRTot,BeperkDatum,Versie
 Set BeperkDatum=$P($G(^HULP($J,"PAR","VM","K")),D,3)
 Set Versie=$P($G(^HULP($J,"PAR","VM","K")),D,2)
 I $D(^HULP($J,"PAR","VM","L")) S Refetch=1 ; Niet de eerste keer
 S MBList=$G(^HULP($J,"PAR","VM","L"),"B"),^("L")=MBList
 K ^HULP($J,"PAR","VM","R")
 S (VMB(9),VNR,VNRTot)=0,UHG=0
 I $D(^KKAAP(KC,0,0,0,0)) S ^HULP($J,"K"_KC,"VM")=^(0)
FETCH1 S UHG=$N(^KKAAP(KC,UHG)),UGR=0 I UHG=-1 D O2^RPLKL2:'$D(^HULP($J,"K"_KC,"VM")) G FETCH5
FETCH2 S UGR=$N(^KKAAP(KC,UHG,UGR)) G FETCH1:UGR=-1 S USG=0
FETCH3 S USG=$N(^KKAAP(KC,UHG,UGR,USG)) G FETCH2:USG=-1 S UPR=0
FETCH4 S UPR=$N(^KKAAP(KC,UHG,UGR,USG,UPR)) G FETCH3:UPR=-1 S U2=^(UPR)
 S PRNr=$P(U2,D,15)
 I MBList="B" G FETCH4:$P(U2,D,17)
 S $P(U2,D,18)=$ZR,R=$P(U2,D,8),$P(U2,D,8)=$S(R="E":"",R="H":"%",1:R)
 S:+$P(U2,D,9)=+$P(U2,D,6) $P(U2,D,9)=""
 S R=$P(U2,D,5) D XT^RPLKL2 S $P(U2,D,16)=$H-R>182
 If $$INTDATE^vhLib.DataTypes($P(U2,D,5))'<BeperkDatum!$D(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Do
 . S VNR=VNR+1 I VNR=18,'$G(Refetch) D SHOW
 . S ^HULP($J,"K"_KC,"VMI",PRNr)=VNR
 . S ^HULP($J,"K"_KC,"VMIBEP",PRNr)=VNR
 . S ^HULP($J,"K"_KC,"VM",VNR)=U2
 . S ^HULP($J,"K"_KC,"VMBEP",VNR)=U2
 . D MODPRIJS("^HULP($J,""K""_KC,""VM"",VNR)")
 . S ^HULP($J,"K"_KC,"VMO",VNR)=^HULP($J,"K"_KC,"VM",VNR)
 . S ^HULP($J,"K"_KC,"VMOBEP",VNR)=^HULP($J,"K"_KC,"VM",VNR)
 S VNRTot=VNRTot+1
 S ^HULP($J,"K"_KC,"VMITOT",PRNr)=VNRTot
 S ^HULP($J,"K"_KC,"VMTOT",VNRTot)=U2
 D MODPRIJS("^HULP($J,""K""_KC,""VMTOT"",VNRTot)")
 S ^HULP($J,"K"_KC,"VMOTOT",VNRTot)=^HULP($J,"K"_KC,"VMTOT",VNRTot)
 G FETCH4
FETCH5 S VMB(9)=VNR 
 Set PRNr=""
 For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Quit:'PRNr  Do
 .Do:'$G(^HULP($J,"K"_KC,"VMITOT",PRNr)) ADD(PRNr,0)
 If '$G(Refetch),VNR'>17 Do SHOW
 Do:$G(Refetch)
 . If Versie="T" Do
 . . Set $P(^HULP($J,"PAR","VM","K"),D,2)="B"
 . . Do SWITCH()
 . Else  Do
 . . Set:VMB(6)>VMB(9) VMB(6)=VMB(9) Kill VMB(7)
 . . Do SHOW
 If '$O(^HULP($J,"K"_KC,"VM","")),Versie'="T" Do SWITCH()
 Quit
 ;
SHOW I $G(VMB(9)),'VMB(6) S (VMB(6),VMB(7))=1
 D WL^RPLKL2
 Set FP=2401 Write @F,@F1
 Q
ADD(PRNr,Show) 
 New U2,B
 If $G(DL(1))="PRF"
 Else  Do
 .If $D(^HULP($J,"K"_KC,"VMI",PRNr)) Do  Quit
 ..Quit:'Show
 ..Quit:VMB(6)=^(PRNr)
 ..Set VMB(6)=^(PRNr)
 ..If VMB(6)<VMB(7) Kill VMB(7)
 ..Else  If VMB(6)-VMB(7)'<VMB(4) Kill VMB(7)
 ..Do MODPRIJS("^HULP($J,""K""_KC,""VM"",VMB(6))"),WL^PROC
 .If $D(^HULP($J,"K"_KC,"VMITOT",PRNr)) Do  Quit
 ..Do SWITCH(PRNr)
 .Do FETCHPR^UTILI(PRNr) Quit:'$D(B)
 .Set U2=""
 .Set U2=$P(B(3),D,25)_D_$P(B(1),D,1)_D_"NIEUW"
 .Set $P(U2,D,9,11)=$P($$KLANTPR^KPRIJS(KC,PRNr),D,1,3)
 .Set:$E($P(U2,D,11))="H" $P(U2,D,11)="%"
 .Set $P(U2,D,7,8)=$P(U2,D,10,11)
 .Set $P(U2,D,15)=PRNr
 .Set $P(U2,D,51)=$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D,3)
 .Set:+$P(U2,D,51)=+$P(U2,D,9) $P(U2,D,51)=""
 .Set:'Show VMB(9)=VMB(9)+1,^HULP($J,"K"_KC,"VM",VMB(9))=U2
 .If Show Do NIEUWV^PROC3(U2) ;Do MODPRIJS("^HULP($J,""K""_KC,""VM"",VMB(6))")
 .Set ^HULP($J,"K"_KC,"VMI",PRNr)=VMB(9)
 .Set U2=^HULP($J,"K"_KC,"VM",VMB(9))
 .Set:$$ISKLPR^KS(KC,PRNr) $P(U2,D,7,11)="\\\\"
 .Set ^HULP($J,"K"_KC,"VMO",VMB(9))=U2
 Quit
 
 ;
PRINT 
 New R,Titel,Position
 Set R=$$CHECKFAX(KC)
 If R=1 Do
 .Do STORE^vhTERMINA()
 .Set Titel=$P(^RES("RPLMBON","PI","OUTPUT"),"`")
 .Set Position="12;"_(80-$P(^RES("RPLMBON","PI","OUTPUT","P","O"),"`",4)\2)
 .Set R=$$PI^vhPOPUP(Position,"1O-",Titel,"RPLMBON","OUTPUT","","",1)
 .Do REFRESH^vhTERMINA()
 If $L(R) Do OUTPUT(R="F")
 Quit
 
 ;
FAX 
 New R
 Do OUTPUT(1)
 Quit
 
EDI 
 Do EDI^RPLKL4
 Set R=U4
 Quit
 
ORDER(KLNr) 
 Do STORE^vhTERMINA()
 Do
 .New (KlantObject,KLNr,QU)
 .Do
 ..New KlantObject,KLNr,QU
 ..Do INIT^vhTERMINA
 .Do MARKLOG^RPLMBON(KLNr)
 .Set DLogNr=$P(^MBLOG("D",$$IO^cQ5,KLNr),D)
 .Set KC=KLNr
 .Do TRANSFER,BUILDOBJ^FLOWORD(KLNr,DLogNr)
 .Kill ^MBLOG("D",$$IO^cQ5,KLNr)
 Do REFRESH^vhTERMINA()
 Quit
 ;
OUTPUT(Fax) 
 New R,%SC
 Set Fax=$G(Fax)
 If $D(^MBLOG("D",$$IO^cQ5,KC)) Do
 .New Rec,Ref,Bel,Week,Dag,VroegsteLeverDag,%TC,%INT,%EXT,OrdBev,ExtPers,FaxNrOrEmail,Tav,ATK,OrgalRef,IsOrgal,VerpTyp,PRNr,IsMaatWerk,VerzendWijze,LandCode,PostCode,blVerzendWijze,blLeveringsTermijn
 .Set VerzendWijze=$$DEFAULT^KLVERZW(,KC)
 .Set LandCode=$$LAND^vhRtn1(KC,"K")
 .Set PostCode=$P(^KKL(^KK1(KC),0),D,6)
 .Set blVerzendWijze=##class(APPS.VKP.VerzendWijze).%New(KC,VerzendWijze,LandCode,PostCode)
 .Set blLeveringsTermijn=##class(APPS.VKP.LeveringsTermijn).%New($H,blVerzendWijze)
 .Set IsOrgal=$$ISORGAL^FLOW("M",$$IO^cQ5,KC)
 .Set PRNr=""
 .For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Quit:PRNr=""  Set IsMaatWerk=$$IsMaatWerk^PRODUKT2(PRNr) Quit:IsMaatWerk
 .Set Rec=^MBLOG("D",$$IO^cQ5,KC)
 .Set Ref=$P(Rec,D,3),Bel=$P(Rec,D,4),(Week,Dag)=$P(Rec,D,7),OrgalRef=$P(Rec,D,11),VerpTyp=$P(Rec,D,12)
 .Do:Dag=""  ; Opzoeken van de vroegst mogelijke leverdag
 ..Set PRNr=""
 ..For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Quit:PRNr=""  Set R=$$GetLeverDag^FLOW3(KC,PRNr,,1) S:R>Dag Dag=R
 .Set VroegsteLeverDag=Dag,Tav=$P($P(Rec,D,8),"#"),ATK=$P($P(Rec,D,8),"#",2),OrdBev=$P(Rec,D,9)
 .Do:OrdBev=""
 ..Set OrdBev=$P(^KKL(^KK1(KC),1),D,19)
 ..If $E(OrdBev,2)="M",'IsMaatWerk Set (OrdBev,FaxNrOrEmail)="" Quit
 ..If $E(OrdBev)="F" Set FaxNrOrEmail=$P(^KKL(^KK1(KC),1),D,24)
 ..Else  Set FaxNrOrEmail=$$GetDefaultemKlant^FaxMail(KC,,,,"O"_$S(IsMaatWerk:"M",1:""))
 ..Set:$E(OrdBev)="F" OrdBev=FaxNrOrEmail Set:$E(OrdBev)="M" OrdBev=FaxNrOrEmail
 .Set:'$L(Ref) Ref=$$EXTDATE^vhLib.DataTypes($H,"DKP")_" "
 .Set:$L(Bel) Bel=$$INTDATE^vhLib.DataTypes(Bel) Set:$L(Week) Week=$$INTDATE^vhLib.DataTypes(Week,"DW")
 .Set:VerpTyp="" VerpTyp=$$KLANT^VERPAK(KC)
 .Do NIEUW^vhScherm("RPLMBON","","",0,"","",3)
 .Set:Bel Bel=$$EXTDATE^vhLib.DataTypes(Bel,"DKP") Set:Week Week=$$EXTDATE^vhLib.DataTypes(Week,"DW")
 .Set $P(Rec,D,3)=Ref,$P(Rec,D,4)=Bel,$P(Rec,D,7)=Dag
 .Set $P(Rec,D,8)=Tav_"#"_ATK,$P(Rec,D,9)=OrdBev,$P(Rec,D,11)=OrgalRef,$P(Rec,D,12)=VerpTyp
 .Set ^MBLOG("D",$$IO^cQ5,KC)=Rec
 If $G(%SC),$$USERNAME^vhUSER(,-1)="VBL" Do OUTPUTL,REFRESH^RPLKL4 ; Enkel voor VBL
 Set FP=2401 Write @F,@F1
 Quit
 ;
 ; Controle ingave leverweek
ChkLevWk(LevWk,Beloofd,sEr)
 New HuidWeek,DiffDate
 Do:LevWk
 . If Beloofd,LevWk'=$$INTDATE^vhLib.DataTypes($$EXTDATE^vhLib.DataTypes(Beloofd,"DW"),"DW") Set sEr="Moet gelijk zijn aan de beloofde week"
 . Else  Do
 . . Set:$$CALCDATE^vhLib.DataTypes(LevWk,"W",0,"LD")<$H LevWk=$$INTDATE^vhLib.DataTypes($$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes(LevWk,"J","+1"),"DW"),"DW")
 . . Set HuidWeek=$$EXTDATE^vhLib.DataTypes(,"DW"),LevWk=$$EXTDATE^vhLib.DataTypes(LevWk,"DW")
 . . Set DiffDate=$$DIFFDATE^vhLib.DataTypes(HuidWeek,LevWk,"DW")
 . . Quit:DiffDate/7'>10
 . . Quit:$$^vhTXTPOP("RPLMBON","PLUS10WEKEN","",LevWk,DiffDate/7,HuidWeek)  ; Ingegeven leverweek is meer dan 10 weken te ver
 . . Set sEr=-1
 Quit
 ;
 ; Controle ingave leverdag
ChkLeverDag(LeverDag,sEr)
 New HuidDag,DiffDate
 Do:LeverDag
 . Set HuidDag=$$EXTDATE^vhLib.DataTypes(),LeverDag=$$EXTDATE^vhLib.DataTypes(LeverDag)
 . Set DiffDate=$$DIFFDATE^vhLib.DataTypes(HuidDag,LeverDag)
 . Quit:DiffDate/7'>10
 . Quit:$$^vhTXTPOP("RPLMBON","PLUS10WEKENPD","",LeverDag,DiffDate\7,HuidDag)  ; Ingegeven leverdatum is meer dan 10 weken te ver
 . Set sEr=-1
 Quit
 ;
 ; Print Callback
PRINTCB(Ref) 
 If $L(Ref)>1 Set Rec=@Ref,PRNr=$P(Rec,D) I +Rec<0 Do  Quit ";10"
 .Set FL(1)=VMB(2),FL(2)="",FL(3)=Rec
 .Do FL^PROC S FL(3,1)=R
 .Set Rec=$$CHECK^ORDERT(-PRNr,KC,$G(^MBLOG("D",$$IO^cQ5($P),KC,-PRNr)),"","","S")
 .If $L(Rec) Set $E(FL(3,1),28,28+$L(Rec)-1)=Rec
 Q:Ref'="B" ""
 S FL(3)="" I $D(^HULP($J,"K"_KC,"V")) S $P(FL(3),D,12)=^("V")
 Quit ";9\;1\;2\;1\;3\;1\;4\;1\;11\;1\;5\;1\;6\;1\;7\;1\;8\;1\;12\;1"
 ;
 ;Opbouw van print hulp global
OUTPUTL New VMB,DL,MBLog,I1,I2,Week,IsOrgal
 Set IsOrgal=$$ISORGAL^FLOW("M",$$IO^cQ5,KC)
 Kill ^HULP($J,"K"_KC,"VP")
 Set Brutto=$P(^KKL(^KK1(KC),2),D,5),Week=$P(^MBLOG("D",$$IO^cQ5,KC),D,7)
 Set:Week'?5N Week=$$INTDATE^vhLib.DataTypes(Week,"DW")
 Set PRNr=""
 Set (PAKNr,PRNr)=""
 For  Set PAKNr=$O(^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr)) Quit:'PAKNr  Do
 .Set PakQty=^(PAKNr)
 .Set Pak=$G(^PAKKET("D",PAKNr)) Quit:'$L(Pak)
 .If $P(Pak,D,3)'="D" Quit
 .Set Key=$$UPTRIMAN^vhRtn1($P(Pak,D,2))_" "
 .Set Rec="**                      **"
 .Set $E(Rec,$L(Rec)-$L($P(Pak,D,2))\2,$L(Rec)-$L($P(Pak,D,2))\2+$L($P(Pak,D,2)))=$P(Pak,D,2)
 .Set ^HULP($J,"K"_KC,"VP",Key)=D_Rec_D_D_1
 .For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,"P",PAKNr,PRNr)) Quit:'PRNr  Do
 ..Set Qty=^(PRNr)
 ..Do OUTPUTP(PRNr,Key,Qty,0,Week)
 .Set Rec=Key For  Set Rec=$O(^HULP($J,"K"_KC,"VP",Rec)) Quit:$E(Rec,1,$L(Key))'=Key  Set OldRec=Rec ; Opzoeken laatste lijn van pakket
 .Set $P(^HULP($J,"K"_KC,"VP",OldRec),D,2)="*-----------------------*"
 Set PRNr="",Key="~ "
 For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Quit:'PRNr  Do
 .Set Qty=$P(^(PRNr),D)
 .Quit:'Qty&$P(^(PRNr),D,2)
 .Do OUTPUTP(PRNr,Key,Qty,1,Week)
 Goto FAXL^RPLMBON2:Fax
 Set Rec=""
 Set $P(Rec,D,2)="............................"
 Set $P(Rec,D,11)="............................"
 Set $P(Rec,D,12)="............................"
 For Cnt=1:2:5 Set ^HULP($J,"K"_KC,"VP","~~ "_Cnt)="",^("~~ "_(Cnt+1))=Rec
 If '$D(^HULP($J,"K"_KC,"VP")) W *7 Quit
 Do INIT^PROC("RPLKLVMB","VMB")
 S VMB(11)="Moederbon "_$P($G(^MBLOG("D",$$IO^cQ5,KC)),D)_D_$$NAAM^RPLKL4()
 S VMB(2,1)=";C;L;1\"
 S KlNm=KC_" "_$P(^KKL(^KK1(KC),0),D,2)
 S WnPl=$$LAND^vhRtn1($P(^KKL(^KK1(KC),0),D,8)),WnPl=$S(WnPl="BE":"",1:WnPl_" ")
 S WnPl=WnPl_$P(^KKL(^KK1(KC),0),D,7)
 S VMB(2,2)="""Klant"";C;R;16;; : \KlNm;C;L;40;;;1"
 S VMB(2,3)="""Woonplaats"";C;R;16;; : \WnPl;C;L;40"
 S VMB(2,4)="""Referentie"";C;R;16;; : \""."";F;L;40"
 D:$L($P($G(^MBLOG("D",$$IO^cQ5,KC)),D,3))
 .S VMB(2,4)="""Referentie"";C;R;16;; : \$P(^MBLOG(""D"",$$IO^cQ5($P),KC),D,3);C;L;40"
 S VMB(2,5)="""Beloofd"";C;R;16;; : \""."";F;L;40"
 D:$L($P($G(^MBLOG("D",$$IO^cQ5,KC)),D,4))
 .S VMB(2,5)="""Beloofd"";C;R;16;; : \$P(^MBLOG(""D"",$$IO^cQ5($P),KC),D,4);C;L;40"
 S VMB(2,6)="""Leveringsadres"";C;R;16;; : \""."";F;L;40"
 S VMB(2,7)=";C;R;16;; : \""."";F;L;40"
 D:$L($G(^MBLOG("D",$$IO^cQ5,KC,"LEVADR")))
 .S VMB(2,6)="""Leveringsadres"";C;R;16;; : \$P(^MBLOG(""D"",$$IO^cQ5($P),KC,""LEVADR""),D,2);C;L;40"
 .S VMB(2,7)=";C;R;16;; : \$P(^MBLOG(""D"",$$IO^cQ5($P),KC,""LEVADR""),D,5)_"" - ""_$P(^(""LEVADR""),D,7);C;L;40"
 S VMB(2,8)="""Verzendingswijze"";C;R;16;; : \""."";F;L;40"
 S VMB(2,9)="""-"";F;R;80;;"
 S VMB(2,10)="1.1;C;R;80;;"
 S VMB(2,11)=""""_$P("Commissie\Orgalux",D,IsOrgal+1)_""";C;R;16;; : \""."";F;L;40"
 D:$L($P($G(^MBLOG("D",$$IO^cQ5,KC)),D,11))
 .S VMB(2,11)=""""_$P("Commissie\Orgalux",D,IsOrgal+1)_""";C;R;16;; : \$P(^MBLOG(""D"",$$IO^cQ5($P),KC),D,11);C;L;40"
 S VMB(2,12)="""Verpakkingswijze"";C;R;16;; : \""."";F;L;40"
 D:$L($P($G(^MBLOG("D",$$IO^cQ5,KC)),D,12))
 .S VMB(2,12)="""Verpakkingswijze"";C;R;16;; : \$S($L($P(^MBLOG(""D"",$$IO^cQ5($P),KC),D,12),U)>1:$P(^MBLOG(""D"",$$IO^cQ5($P),KC),D,12),1:$$DISPSTR^vhPOPUP(""P"",$TR(""VERPAK#TYPE"",""#"",U),$P(^MBLOG(""D"",$$IO^cQ5($P),KC),D,12),""KO""));C;L;40"
 S VMB(10)="PRINTCB^RPLMBON"
 Do OUTPUT^RPLKL4
 ;Kill ^HULP($J,"K"_KC,"VP")
 Quit
 ; Opslaan van 1 produkt
OUTPUTP(PRNr,Key,Qty,KlantRef,Week) 
 New B
 Do FETCHPR^UTILI(PRNr) Quit:'$D(B)
 Set Stock=$P(B(2),D,20)
 Set Rec=PRNr_D_$P(B(1),D)_D_$P(B(3),D,25)_D_Stock_D_$$GETSTOCK^PRODUKT4(PRNr,"F")
 Do:$L(B("J"))
 .Set MinBH="........................."
 .If Qty Set MinBH=Qty
 .Else  Set:'Stock MinBH=$TR($FN($P(B("J"),D,6),",",0),".,",",.")
 .Set Datum=$G(Week) Set:Datum="" Datum="........................."
 .Set:'Stock Datum=$$CALCDATE^vhLib.DataTypes($H,"W",$P(B("J"),D,7)+1,"MD")
 .Set Verpak=$P(B("J"),D,16)
 .Set:$P(B("J"),D,15) Verpak=Verpak_"/"_$P(B("J"),D,15)
 .Set:$P(B("J"),D,14) Verpak=Verpak_"/"_$P(B("J"),D,14)
 .If $P(B("J"),D,13) Set Verpak=Verpak_"*"
 .Set $P(Rec,D,10)=Verpak_D_Datum_D_MinBH
 Set Prijs=$$KLANTPR^KPRIJS(KC,PRNr)
 Set $P(Rec,D,15)=$P(Prijs,D,1,3)
 Set Key=Key_$P(B("I"),D,3)_$$COMPR^PRODUKT(PRNr)
 Set ^HULP($J,"K"_KC,"VP",Key_" ")=Rec
 Set Filler=""
 If KlantRef Set PAKNr="" For  Set PAKNr=$O(^PAKKET("IP",PRNr,KC,PAKNr)) Quit:'PAKNr  Do
 .Set Pak=^PAKKET("D",PAKNr) Quit:$P(Pak,D,3)="D"
 .Set Filler=Filler_";"_$P(Pak,D,2)
 Set:$L(Filler) Filler="-->"_$E(Filler,2,99)
 Set ^HULP($J,"K"_KC,"VP",Key_"~")=-PRNr_D_Filler
 Quit
 
SELECT(KLNr) 
 Quit:'$D(^MBLOG("T",KLNr)) ""
 Set KLNm=$P(^KKL(^KK1(KLNr),0),D,2)
 Set LogNr="",Y=0
 For  Set LogNr=$O(^MBLOG("T",KLNr,LogNr)) Quit:LogNr=""  Do
 .Set Y=Y+1
 .Set Y(Y)=LogNr_D_^MBLOG("T",KLNr,LogNr)
 If Y=1 Quit $P(Y(1),D,1)
 Set X=1
 Set Y(0)=Y
 Set Y=21_D_"B"_D_"Selecteer een moederbon (- = Exit)"_D_D_D_"RPLMBONS"
 D ^POP
 S:X X=$P(Y(X),D,1)
 S:'X X=""
 Quit X 
 
CHKITEM(R) 
 New AddItem,PRNr
 Set AddItem=0
 If R="ENTER",$D(^HULP($J,"K"_KC,"VM",VMB(6))) Set AddItem=1
 If R="C",$D(^HULP($J,"K"_KC,"VM",VMB(6))) Set AddItem=1
 If R="V",$D(^HULP($J,"K"_KC,"VM",VMB(6))) Do
 .Set PRNr=$P(^HULP($J,"K"_KC,"VM",VMB(6)),D,15)
 .If PRNr,$D(^MBLOG("D",$$IO^cQ5,KC,PRNr)) Set AddItem=1
 If R="KST",$D(^HULP($J,"K"_KC,"VM",VMB(6))) Do
 .Set PRNr=$P(^HULP($J,"K"_KC,"VM",VMB(6)),D,15)
 .If PRNr,$$IsKSKlant(KC),'$$ISPROD^KS(PRNr) Set AddItem=1
 If R="X",$D(^MBLOG("D",$$IO^cQ5,KC)) Set AddItem=1
 If R="VOVZ",$$CONTNACT(),$G(^HULP($J,"PAR","VM","L"))="B" Set AddItem=1
 If R="BOVZ",$$CONTNACT(),$G(^HULP($J,"PAR","VM","L"))="V" Set AddItem=1
 Quit AddItem
 
 ; Nazien of de verkoopanalyse niet actieve produkten bevat
CONTNACT() 
 New ContNAct,HoofdGr,Groep,SubGr,CompKort
 Set HoofdGr=0
 For  Set HoofdGr=$O(^KKAAP(KC,HoofdGr)) Quit:HoofdGr=""  Do  Quit:ContNAct
 .Set Groep=""
 .For  Set Groep=$O(^KKAAP(KC,HoofdGr,Groep)) Quit:Groep=""  Do  Quit:ContNAct
 ..Set SubGr=""
 ..For  Set SubGr=$O(^KKAAP(KC,HoofdGr,Groep,SubGr)) Quit:SubGr=""  Do  Quit:ContNAct
 ...Set CompKort=""
 ...For  Set CompKort=$O(^KKAAP(KC,HoofdGr,Groep,SubGr,CompKort)) Quit:CompKort=""  Do  Quit:ContNAct
 ....Set R=^KKAAP(KC,HoofdGr,Groep,SubGr,CompKort),ContNAct=$P(R,D,17)
 Quit $G(ContNAct)
 
CHECKFAX(KLNr) 
 New CheckOut,PRNr
 Set CheckOut=0
 If 0,$P(^KKL(^KK1(KLNr),1),D,10)=2671 Do  ; Niet meer voor klant van Haefele
 .Set PRNr=0
 .For  Set PRNr=$O(^MBLOG("D",$$IO^cQ5,KLNr,PRNr)) Quit:PRNr=""  Do  Quit:CheckOut
 ..If $D(^KPR(PRNr,"J5005")) Set CheckOut=1
 Set CheckOut=CheckOut+$P($G(^MBLOG("D",$$IO^cQ5,KLNr)),D,6)
 Quit CheckOut
 
CHECKORD(KLNr) 
 Goto CHECKORD^RPLMBON3
 
MODPRIJS(Ref) 
 New R,Aantal,Munt,BrutoPr,IsHandel,Korting1,Korting2,Prijs,PRNr
 Set PRNr=$P(@Ref,D,15),Aantal=$P($G(^MBLOG("D",$$IO^cQ5,KC,PRNr)),D)
 If Aantal,$$ISKLPR^KS(KC,PRNr) Do
 .Set Munt=$P(^KKL(^KK1(KC),0),D,11),BrutoPr=$P(^KKL(^KK1(KC),2),D,5),IsHandel=$$IsHandel^KLANT5(KC)
 .Set R=$$KORTPC^KORTING(KC,PRNr,"","",Aantal),Korting1=$P(R,D),Korting2=$P(R,D,2)
 .Set R=$$PROD^KPRIJS(PRNr,Korting1,Korting2,Munt,BrutoPr,IsHandel),Prijs=$P(R,D)
 .Set:+$P(@Ref,D,9)'=+Prijs $P(@Ref,D,9)=Prijs
 Quit
 
DEACTIV 
 Do MODACTIV(1)
 Quit
 
ACTIVATE 
 Do MODACTIV("")
 Kill:'$$CONTNACT() ^HULP($J,"PAR","VM","L")
 Quit
 
MODACTIV(MBonTyp) 
 New R,PRNr,ZR
 Set R=$G(^HULP($J,"K"_KC,"VM",VMB(6))),PRNr=$P(R,D,15),ZR=$P(R,D,18)
 If PRNr,$D(^KSTKL(KC,PRNr)) Do
 .Set R=^KSTKL(KC,PRNr,0),$P(R,D,11)=MBonTyp,^KSTKL(KC,PRNr,0)=R
 .Set R=@ZR,$P(R,D,17)=MBonTyp,@ZR=R
 .Do DLOGMOD^LOG("KL",KC,,$S(MBonTyp:"Actief",1:"Niet actief"),$S(MBonTyp:"Niet actief",1:"Actief"),"Mb:"_$P(^KPR(PRNr,0),D))
 .Set Input="REFRESH"
 Quit
 
 ; Wisselen tussen beperkte en volledige lijst
SWITCH(PRNrToSelect)
 New I,R,Versie,PRNr,VM
 Merge VM=^HULP($J,"K"_KC,"VM")
 Set PRNr=$G(PRNrToSelect)
 Set:'PRNr PRNr=$P($G(VM(VMB(6))),D,15)
 Set Versie=$P($G(^HULP($J,"PAR","VM","K")),D,2)
 Kill ^HULP($J,"K"_KC,"VMI")
 Kill ^HULP($J,"K"_KC,"VM")
 Kill ^HULP($J,"K"_KC,"VMO")
 If Versie="T" Do
 . Merge ^HULP($J,"K"_KC,"VMI")=^HULP($J,"K"_KC,"VMIBEP")
 . Merge ^HULP($J,"K"_KC,"VM")=^HULP($J,"K"_KC,"VMBEP")
 . Merge ^HULP($J,"K"_KC,"VMO")=^HULP($J,"K"_KC,"VMOBEP")
 Else  Do
 . Merge ^HULP($J,"K"_KC,"VMI")=^HULP($J,"K"_KC,"VMITOT")
 . Merge ^HULP($J,"K"_KC,"VM")=^HULP($J,"K"_KC,"VMTOT")
 . Merge ^HULP($J,"K"_KC,"VMO")=^HULP($J,"K"_KC,"VMOTOT")
 For I=1:1 Set R=$G(VM(I)) Quit:R=""  Do
 . Quit:$P(R,D,3)'="NIEUW"
 . Set VNR=$O(^HULP($J,"K"_KC,"VM",""),-1)+1
 . Set ^HULP($J,"K"_KC,"VM",VNR)=R
 . Set ^HULP($J,"K"_KC,"VMO",VNR)=R
 . Set:$P(R,D,15) ^HULP($J,"K"_KC,"VMI",$P(R,D,15))=VNR
 Set $P(^HULP($J,"PAR","VM","K"),D,2)=$S(Versie="T":"B",1:"T") Set VMB(9)=+$O(^HULP($J,"K"_KC,"VM",""),-1)
 If PRNr For I=1:1 Set R=$G(^HULP($J,"K"_KC,"VM",I)) Quit:R=""  If $P(R,D,15)=PRNr Set VMB(6)=I Kill VMB(7) Quit
 Do SA^RPLKL1,SHOW
 Quit
 
BeperkDatum(KLNr)
 New BeperkDatum,Maanden,Regio
 Do:$P($G(^HULP($J,"PAR","VM","K")),D)'=KLNr
 . Kill ^HULP($J,"PAR","VM","K")
 . Kill ^HULP($J,"K"_KC,"VMI")
 . Kill ^HULP($J,"K"_KC,"VM")
 . Kill ^HULP($J,"K"_KC,"VMO") ; Moederbongegevens moeten terug opgehaald worden
 Set:'$D(^HULP($J,"PAR","VM","K")) ^HULP($J,"PAR","VM","K")=KLNr_"\B"
 Set Regio=$P(^KKL(^KK1(KLNr),0),D,20),Maanden=""
 Set:Regio Maanden=$P($G(^RES("KLANT","PI","REGIO","D",Regio)),"`",18) ; Instelling regio
 Set:'Maanden Maanden=$S($$IsKSKlant(KLNr):6,1:3) ; Default
 Set BeperkDatum=$$CALCDATE^vhLib.DataTypes(,"M",-Maanden)
 Set $P(^HULP($J,"PAR","VM","K"),D,3)=BeperkDatum
 Set $P(^HULP($J,"PAR","VM","K"),D,4)=$$EXTDATE^vhLib.DataTypes(BeperkDatum)
 Quit
 
MenuPrompt(Key)
 New Prompt
 Set Prompt=""
 Set:Key="+" Prompt=$S($P(^HULP($J,"PAR","VM","K"),D,2)="T":"Overzicht vanaf "_$P(^HULP($J,"PAR","VM","K"),D,4),1:"Volledig overzicht")
 Quit Prompt