#include BL.Derde.LevSpecifiek
 
HADOPV ;HALUX productie opvolging [ 07/01/2003  10:33 AM ]
 Set Batches=$$BATCHALL^HADBATCH($$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($H,"W","MD"),"W"))
 ;Set Batches="TP "
 Do VERWERK(Batches)
 Quit
 
VERWERK(Batches,TOENr,ORDNr,FabKeyGlobRef) 
 New SelRec,LimRec,MarkTyp,Batch,LevWk,LEVNr,Input,FabKey,PRNr
 Set (MarkTyp,LimRec)=""
 Set DispMode="OP"
 Set TOENr=$G(TOENr)
 Set ORDNr=$G(ORDNr)
 Set LEVNr=6332 ; HALUX
 Set $P(LimRec,D,20)="K"
 Quit:'LEVNr
 Do INIT
 Do FETCH
 Do REFRESH
 For  Do  Quit:Input="-"!(Input="CANC")
 .Set:$E(DispMode)="O" Input=$$SCROLL^vhLIST(.LD)
 .Set:$E(DispMode)="D" Input=$$IN^vhKEY()
 .Set (SelRec,PRNr,KLNr,FabKey)=""
 .If LD("SELECT") Do
 ..Set SelRec=$G(^HULP(%J,"L",LD("SELECT")))
 ..Set FabKey=$$FABKEYB(SelRec)
 ..Set KLNr=$P(SelRec,D,2)
 ..Set PRNr=$P(SelRec,D,3)
 .If Input="COM"  Set Input="" Do CALL^vhMenu("HADOPV")
 .Do EXEC^vhMenu("HADOPV",.Input)
 Quit
 
HERWERK Do INIT,FETCH,REFRESH  
 Quit
 
INIT Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set FabKeyGlobRef=$G(FabKeyGlobRef)
 Set SubPRNr=""
 Do INIT^vhLIST("HADOPV","OVZ",.LD)
 Quit
 
REFRESH 
 Write @F11,@F1
 Set MarkOms=$$MARKOMS(MarkTyp)
 Set MarkOms=$S($E(DispMode)="D":"Detail",$L(MarkOms):$S(MarkTyp="BATCH":"",1:"Mode : ")_MarkOms,DispMode="OG":"Overzicht glas",1:"")
 Do DISPLAY^vhScherm("HADOPV")
 Do:$E(DispMode)="O" WRITE^vhLIST(.LD)
 If $E(DispMode)="D" Do DISPDTL
 Quit
 
SHOWDTL New Nodes,Soorten,VolgNr,Rec,Node,Soort,RecO,I,J
 If $E(DispMode)'="D" Do
 .Set DispMode="D"_$E(DispMode,2)
 .Do REFRESH
 Else  Do DISPDTL
 Quit
 
DISPDTL
 New GenType
 Set GenType=$$GENTYP^HAD(PRNr)
 If PRNr="" Do NOSUB Quit
 If $$HeeftHalfFabr(PRNr) Do  Quit
 .Do RAADPL^PRLINK(PRNr,,FabKey)
 .Set DispMode="OP"
 .Do REFRESH
 If DispMode="DG" Do
 .If '$D(^HADPR("P",PRNr,"GV")) Do NOSUB Quit
 .Do DISPGLAS^HADVUL(PRNr,$P(SelRec,D,6),$P(SelRec,D,5),KLNr)
 Else  Do
 .If $P(SelRec,D)="DV" Do NOSUB Quit
 .Set sFL("G")=$G(^KPR(PRNr,"G"))
 .Set sFL("O")=$G(^HADPR("P",PRNr,"O",1))
 .Do DISPLAY^vhScherm("HADOPVDTL")
 Quit
 
NEXTDTL(Dir) 
 New End
 Set End=0
 For  Do  Quit:End 
 . Set LD("SELECT")=LD("SELECT")+Dir
 . If LD("SELECT")<1 Set LD("SELECT")=1,End=1 W *7
 . Else  If LD("SELECT")>LD("MAX") Set LD("SELECT")=LD("MAX"),End=1 W *7
 . Else  If DispMode="DG" Do
 .. New SelRec,PRNr
 .. Set SelRec=^HULP(%J,"L",LD("SELECT"))
 .. Set PRNr=$P(SelRec,D,3)
 .. Quit:PRNr=0
 .. Set:$D(^HADPR("P",PRNr,"GV")) End=1
 . Else  Set End=1
 Set SelRec=^HULP(%J,"L",LD("SELECT"))
 Set KLNr=$P(SelRec,D,2)
 Set PRNr=$P(SelRec,D,3)
 Do SHOWDTL
 Quit
 
SHOWOVZ(Mode) Set DispMode=Mode 
 Do REFRESH
 Quit
 
NOSUB Set FP=2001 Write @F,@F1
 ;Do HLIJN^vhTERMINA(20,1,80,0,0,0)
 Quit
 
FETCH 
 New Rec,I,J,Soort,Node,RecO,SortNr,VolgNr
 Kill ^HULP(%J,"O")
 Set SortNr=""
 Set Rec=""
 Set Batches2=Batches
 Set:TOENr!ORDNr!$L(FabKeyGlobRef) Batches2=$$BATCHALL^HADBATCH()
 For I=1:1:$L(Batches2,";") Do
 .Set Batch=$P(Batches2,";",I)
 .Quit:'$L(Batch)
 .Quit:'$D(^HADPR("O",Batch))
 .Set VolgNr=""
 .For  Set VolgNr=$O(^HADPR("O",Batch,VolgNr)) Quit:VolgNr=""  Do
 ..Set RecO=$G(^HADPR("O",Batch,VolgNr))
 ..Set FabKey=$$FABKEYB(RecO)
 ..Quit:'$$CHECK(RecO,FabKey)
 ..Set SortNr=SortNr+1
 ..Set SortKey=$$SORTKEY(RecO,FabKey,$P(LimRec,D,20))
 ..Set ^HULP(%J,"O",SortKey,SortNr)=RecO
 Kill ^HULP(%J,"L")
 Set (SortKey,VolgNr,Cnt)=""
 For  Set SortKey=$O(^HULP(%J,"O",SortKey)) Quit:SortKey=""  Do
 .For  Set VolgNr=$O(^HULP(%J,"O",SortKey,VolgNr)) Quit:VolgNr=""  Do
 ..Set Cnt=Cnt+1
 ..Set ^HULP(%J,"L",Cnt)=^HULP(%J,"O",SortKey,VolgNr)
 Kill ^HULP(%J,"O")
 Quit
 
SORTKEY(RecO,FabKey,Type) 
 New SortKey,KLNr,PRNr,RecG,DueOut
 Set SortKey="*"
 If Type="D" Do  Quit SortKey ; ProductieWeek/Dag
 .Set KLNr=$P(RecO,D,2)
 .Quit:'KLNr
 .Set DueOut=$$DUEOUTFabKey^HAD(FabKey)
 .Set Half=$S(+$P(DueOut,",",2)<(13*3600):1,1:2)
 .Set SortKey=+DueOut_";"_Half_";"_^KK1(KLNr)
 If Type="K" Do  Quit SortKey ; Klant
 .Set KLNr=$P(RecO,D,2)
 .Quit:'KLNr
 .Set SortKey=^KK1(KLNr)
 Set PRNr=$P(RecO,D,3)
 Set RecG=$G(^KPR(PRNr,"G"))
 Set:RecG="" RecG=$G(^KPRO(PRNr,"G"))
 If Type="B" Do  Quit SortKey ; Batch+Profiel
 .Set SortKey=$P(RecO,D,8)_";"_$P(RecG,D,2)
 If Type="P" Do  Quit SortKey ; Profiel
 .Set SortKey=$P(RecG,D,2)
 If Type="M" Do  Quit SortKey ; Montage+Toepassing
 .Set SortKey=$P(RecO,D,1)_";"_$P(RecG,D,5)_";"_$P(RecG,D,2)
 Quit SortKey
 
CHECK(RecO,FabKey) 
 New PRNr,Chk,RecG,RecF,I
 Set Chk=1
 ; De toegelaten FabKey's zijn opgenomen in de FabKeyGlobRef 
 If $L(FabKeyGlobRef) Quit $D(@FabKeyGlobRef@(FabKey))>0
 ; Toelevering
 If TOENr'="" Quit:TOENr'=$P(RecO,D,6) 0
 ; Order
 If ORDNr'="" Quit:ORDNr'=$P(RecO,D,4) 0
 ; Montage, Zonder, Diverse
 If $P(LimRec,D,1)'="" Quit:$P(LimRec,D,1)'[(";"_$P(RecO,D)_";") 0
 ; Incl Klant
 If $P(LimRec,D,10) Quit:$P(LimRec,D,10)'=$P(RecO,D,2) 0
 ; Excl Klant
 If $P(LimRec,D,11) Quit:$P(LimRec,D,11)=$P(RecO,D,2) 0
 If $P(Rec,D)="DV" Quit Chk ; Exit Diverse
 ;Incl Status: Rec behouden indien de status aanwezig is 
 Set PRNr=$P(RecO,D,3)
 Set RecF=$G(^HADPR("F",FabKey))
 If $L($P(LimRec,D,4)) For I=1:1:$L($P(LimRec,D,4),";") Set:$P($G(^HADPR("F",FabKey,$P($P(LimRec,D,4),";",I))),D,3)'="A" Chk=0
 ;Excl Status: Rec verwerpen indien de status aanwezig is 
 For I=1:1:$L($P(LimRec,D,5)) Set:$P($G(^HADPR("F",FabKey,$P($P(LimRec,D,5),";",I))),D,3)="A" Chk=0
 Quit:'Chk Chk
 ;Verder controleren KM of KZ
 Set PRNr=$P(RecO,D,3)
 Set RecG=$G(^KPR(PRNr,"G"))
 Set:RecG="" RecG=$G(^KPRO(PRNr,"G"))
 ; Profiel
 If $P(LimRec,D,2)'="" Quit:$P(LimRec,D,2)'[(""_$P(RecG,D,2)_"") 0
 ; Toepassing
 If $P(LimRec,D,6)'="" Quit:$P(LimRec,D,6)'[(";"_$P(RecG,D,5)_";") 0
 ; Special
 If $P(LimRec,D,3) Quit:'$P(RecG,D,8) 0
 ; Automatisch
 If $G(AutoMark) {
	 If $P(LimRec,D,12) {
		 New ProdDueOut,Beperking
		 Set ProdDueOut=$$DUEOUTFabKey^HAD(FabKey,1)
		 Set Beperking=$P(LimRec,D,12)
		 Set Chk=ProdDueOut'>Beperking
		 If Chk,$P(Beperking,",",2),+ProdDueOut=+Beperking Set Chk=$P(ProdDueOut,",",2)'>$P(Beperking,",",2)
	 }
	 Set:Chk Chk=$P($G(^HADPR("F",FabKey,"K")),D,3)'="A" ; Reeds klaargezet?
 }
 Set RecF=$G(^HADPR("F",FabKey))
 Quit Chk
 
LastToelev(FabKey,MPRNr)
 Set LastWeek="",WIndex="W"
 Set BSKey=""
 For  Set BSKey=$O(^HADPR("F",FabKey,"AR",BSKey)) Quit:BSKey=""  Do
 . Quit:$P(^HADPR("F",FabKey,"AR",BSKey),"\",6)'="F"
 . Set KPRNr=$P(^HADPR("F",FabKey,"AR",BSKey),"\",1)
 . Set FirstWeek=999999,WIndex="W"
 . For  Set WIndex=$O(^KPR(KPRNr,WIndex)) Quit:$E(WIndex)'="W"  Do
 . . Quit:$E(WIndex,9)'="T"
 . . Set R=^KPR(KPRNr,WIndex)
 . . Quit:$P(R,"\",7) 
 . . Set TLWk=$$INTDATE^vhDTyp($P(R,"\",6),"DW")
 . . Set:TLWk<FirstWeek FirstWeek=TLWk
 . Set:(LastWeek<FirstWeek)&&(FirstWeek'=999999) LastWeek=FirstWeek
 Quit LastWeek ;$$FormatDateTime^vhLib("ww",LastWeek)
 
CBOVZ(Select,Rec)  ; Callback voor overzichtslijst
 New KT,KLNr,KLNm,Ref,RefNr
 ;PRNr,FabKey wordt gebruik in de lijst
 Set sFL(2)=""
 Set PRNr=$P(Rec,D,3)
 Set FabKey=$$FABKEYB(Rec)
 Set sFL("S")=$$STATUS(FabKey)
 If $E(sFL("S"),2)="F",$E(sFL("S"),6)'="K",(MarkTyp="") Do ; Stock controle
 . Set Datum=$$LastToelev(FabKey,PRNr)
 . Set:Datum'="" $P(sFL(1),"\",12)="w"_$$FormatDateTime^vhLib("ww",Datum)
 Set KT=$P($G(^KPR(PRNr,0)),D,1)
 Set:KT="" KT=$P($G(^KPRO(PRNr,0)),D,1)
 Set KLNr=$P(Rec,D,2)
 Set KLNm=$S(KLNr:$P(^KKL(^KK1(KLNr),0),D,2),1:"stock")
 Set sFL("G")=$G(^KPR(PRNr,"G"))
 Set:sFL("G")="" sFL("G")=$G(^KPRO(PRNr,"G"))
 Set sFL("P")=$G(^HADPR("F",FabKey))
 Set sFL("O")=$G(^HADPR("P",PRNr,"O",1))
 If '$L(sFL("O")) Do
 . New TLUNr,TOENr,TLNr
 . Set TLUNr=$P(sFL(1),D,5)
 . Set TOENr=$P(sFL(1),D,6)
 . Quit:'TOENr!('TLUNr)
 . Set TLNr=$G(^TO("IU",TOENr,TLUNr))
 . Quit:'TLNr
 . Set sFL("O")=$P($G(^KTO(6332,TOENr,TLNr)),D,25) ; Leveringsdatum
 . Set ProdDueOut=$$DUEOUTFabKey^HAD(FabKey,1)
 . If ProdDueOut Do
 . . Quit:ProdDueOut>$$CALCDATE^vhDTyp($H,"A",5)
 . . Set sFL("O")=(ProdDueOut-$H)_$S(+$P(ProdDueOut,",",2)<(13*3600):"V",1:"N")
 
 If DispMode="OG"
 {
 	If $P(Rec,D)="DV"!($P(Rec,D)="BA")!($P(Rec,D)="PR")  ; Diverse,Banco of profielen
 	{
	 	;Set KT="Diverse"
 	}
 	Else
 	{
		New Prof,Vul,hoogte,Breedte,MinVrGl,VulOms
		If (sFL("G") = "")
		{
			Set KT = "Generisch product"
		}
		Else
		{
			Set Prof=$P(sFL("G"),D,2)
			Set Vul=$P(sFL("G"),D,10)
			Set:Vul="" Vul="  "
			Set Hoogte=$P(sFL("G"),D,8)
			Set Breedte=$P(sFL("G"),D,9)
			If ('$Data(^RES("HAD","PI","PROFIEL","D",Prof))) Do ##class(TECH.ExceptionHandler).Throw(##class(TECH.Exceptions.GeneralErrorException).%New("Geen data voor "_$Name(^RES("HAD","PI","PROFIEL","D",Prof))))
			Set MinVrGl=$P(^RES("HAD","PI","PROFIEL","D",Prof),"`",3)*2
			Set VulOms=$S(MinVrGl!(Vul="  "):$P($G(^RES("HAD","PI","VULLING","D",Vul)),"`",2),1:"**FOUT**")
			Set KT=Vul_$J(Hoogte-MinVrGl,4,0)_"x"_$J(Breedte-MinVrGl,4,0)_$S($L(VulOms):"-"_VulOms,1:"")
		}
 	}
 }
 Set sFL(2)=KLNm_D_KT
 Quit
 
STATUS(FabKey) ; Ophalen van de status volgens FABKEY
 New Stat,IsBold,GenType,PRNr
 Set PRNr=$P($G(^HADPR("F",FabKey)),D,3)
 Quit:'PRNr "Onbekend"_D_1
 Set GenType=$$GENTYP^HAD(PRNr)
 Set Stat="",IsBold=0
 If $$HeeftHalfFabr(PRNr) Do  ; Heeft halffabrikaten
 .Set Stat=Stat_$$STATONE(FabKey,"A") ;Qty te klein in Mag
 .Set Stat=Stat_$$STATONE(FabKey,"F",,,1,.IsBold) ;Qty te klein in Mag
 .Set Stat=Stat_$$STATONE(FabKey,"P",,,1,.IsBold) ;Qty te klein in Mag
 .Set Stat=Stat_$$STATONE(FabKey,"W") ;Qty te klein op Werklvoer
 .Set Stat=Stat_$$STATONE(FabKey,"X",,,1,.IsBold) ;Qty te klein voor toelev
 .Set Stat=Stat_$$STATONE(FabKey,"T",,,1,.IsBold) ;Toelevering
 .Set Stat=Stat_$$STATONE(FabKey,"K") ;Klaarmaken productie
 .Set Stat=Stat_$$STATONE(FabKey,"FP","p") ;Frontplaat gezaagd zonder fronthouders
 .Set Stat=Stat_$$STATONE(FabKey,"FH","f") ;Frontplaat gezaagd met houders greep en reling
 .Set Stat=Stat_$$STATONE(FabKey,"BR","b") ;Bodem en rug gezaagd geboord met rughouders en blumotion
 Else  Do
 .Set Stat=Stat_$$STATONE(FabKey,"B") ;Glas Besteld
 .Set Stat=Stat_$$STATONE(FabKey,"H",,"H") ;Glas Herbesteld
 .Set Stat=Stat_$$STATONE(FabKey,"G",,,1,.IsBold) ;Glas geleverd
 .Set Stat=Stat_$$STATONE(FabKey,"T") ;Tekening frezing
 .Set Stat=Stat_$$STATONE(FabKey,"L") ;Zaaglijst
 .Set Stat=Stat_$$STATONE(FabKey,"Z",,,1,.IsBold) ;geZaagd
 .Set Stat=Stat_$$STATONE(FabKey,"O","F","f",1,.IsBold) ;geFreesd
 .Set Stat=Stat_$$STATONE(FabKey,"P",,,1,.IsBold) ;gePonst
 .Set Stat=Stat_$$STATONE(FabKey,"M",,,1,.IsBold) ;geMont
 .Set Stat=Stat_$$STATONE(FabKey,"V",,,1,.IsBold) ;Verpakt
 Quit Stat_D_IsBold
 
STATONE(FabKey,Code,Full,Part,ChkBold,IsBold) 
 ; Ophalen van 1 status element,
 ; en controle als het partieel is IsBold aan te passen
 ; Full en Part optioneel
 New Val,X
 Set X=$P($G(^HADPR("F",FabKey,Code)),D,3)
 Set:$G(ChkBold)&(X="P") IsBold=1
 Set Val=$S(X="A":$G(Full,Code),X="P":$G(Part,$$LOCASE^vhRtn1(Code)),1:X)
 Set:Val="" Val=" "
 Quit Val
 
SelectExclKlaarZetten(Flag)
 Set LimRec=""
 Set $P(LimRec,D,20)="D"
 Set $P(LimRec,D,5)=$S($G(Flag):"K",1:"")
 Quit 
 
SELECT New LimNode,I
 For I=1,2 Do  ; Verwijderen van ";"
 .Set LimNode=$P(LimRec,D,I)
 .Set:$E(LimNode)=";" $E(LimNode)=""
 .Set:$E(LimNode,$L(LimNode))=";" $E(LimNode,$L(LimNode))=""
 .Set $P(LimRec,D,I)=LimNode
 Do EDIT^vhScherm("HADOPVSEL")
 If $L($P(LimRec,D,2))&($P(LimRec,D,1)="") Set $P(LimRec,D,1)="KM;KZ" ; Indien profieel ingevuld dan allen KM en KZ toegelaten, geen DV
 For I=1,2,6 Do  ; Bijvoegen van ";"
 .Set LimNode=$P(LimRec,D,I)
 .Set:$L(LimNode) $P(LimRec,D,I)=";"_LimNode_";"
 Quit
 
SELTXT() New Txt
 Set Txt=""
 If $L($P(LimRec,D,1)) Set Txt=Txt_"-Montage:"_$P($P(LimRec,D,1),";",2,$L($P(LimRec,D,1),";")-1)
 If $L($P(LimRec,D,2)) Set Txt=Txt_"-Profiel:"_$P($P(LimRec,D,2),";",2,$L($P(LimRec,D,2),";")-1)
 If $L($P(LimRec,D,3)) Set Txt=Txt_"-Speciaal"
 If $L($P(LimRec,D,4)) Set Txt=Txt_"-InclStat:"_$P(LimRec,D,4)
 If $L($P(LimRec,D,5)) Set Txt=Txt_"-ExclStat:"_$P(LimRec,D,5)
 If $P(LimRec,D,10) Set Txt=Txt_"-InclKlant:"_$P(LimRec,D,10)
 If $P(LimRec,D,11) Set Txt=Txt_"-ExclKlant:"_$P(LimRec,D,11)
 Quit $E(Txt,2,99)
 
URGENTIE(Status) Quit:'PRNr
 Lock +^HADPR("F",FabKey)
 Set Urg=$P($G(^HADPR("F",FabKey)),D,2)
 Set $P(^HADPR("F",FabKey),D,2)=$S(Urg=Status:"",1:Status)
 Lock -^HADPR("F",FabKey)
 Do LINE^vhLIST(.LD,LD("SELECT"))
 Quit
 
MODLEVWK 
 New ORDNr,OLUNr,OLNr,TOENr,TLNr,ORec,TRec
 New iToeWk,oToeWk,ToeWk,iOrdWk,oOrdWk
 Set ORDNr=$P(SelRec,D,6)
 Set OLUNr=$P(SelRec,D,7)
 Set TOENr=$P(SelRec,D,8)
 Set OLNr=$G(^ORD("IU",ORDNr,OLUNr))
 Quit:'OLNr
 Set KLNr=$P(SelRec,D,2)
 Set ORec=$G(^KOD(KLNr,"F",ORDNr,OLNr))
 Quit:'ORec
 Set TOENr=$P(ORec,D,27)
 Set TLNr=$P(ORec,D,28)
 Quit:'TOENr!'TLNr
 Set LEVNr=$P(^KTO1(TOENr),D)
 Set TRec=^KTO(LEVNr,TOENr,TLNr)
 Set (ToeWk,oToeWk)=$P(TRec,D,25)
 Set ToeWk=$$INTDATE^vhDTyp(ToeWk)
 Set iToeWk=$P(TRec,D,29)
 Set oOrdWk=$P(ORec,D,25)
 Set iOrdWk=$P(ORec,D,29)
 Set OrdDelta=1
 Do NIEUW^vhScherm("HADOPVWK",,,,,,3)
 Quit
 
MARKDEF(PRNr,TOENr,TLUNr,OverRule) 
 ;Default markering afhankelijk van het type (sommige statussen zijn niet gewenst 
 New Vul,OpmTyp,Montage,GNode,GenRec,GenType
 Set GNode=$G(^KPR(PRNr,"G"))
 Set FabKey=$$FABKEYT(TOENr,TLUNr)
 Set Vul=$P(GNode,D,10)
 Set OpmTyp=$P($G(^HADPR(PRNr,"O",1)),D,1)
 Set Montage="DV"
 Set GenType=$$GENTYP^HAD(PRNr)
 Quit:$$HeeftHalfFabr(PRNr)  ; Heeft halffabrikaten, Tandembox, Grepen op maat, producten op maat
 If $P(GNode,D,8)?1.N,$P(GNode,D,9)?1.N Do  ; Kaderdeur
 .Set Montage=$S($P(GNode,D,11)["K":"KM",1:"KZ")
 ;Quit:$L(Vul)  ; Met vulling, verwijderd 05-04-02 PV
 Do:Vul="" MARKDEF1(FabKey,"BHG","-",$G(OverRule)) ; Geen vulling
 Do:(Vul="ZZ")!(Vul="ZP") MARKDEF1(FabKey,"BH","-",$G(OverRule)) ; Vulling geleverd door klant
 Do:OpmTyp="K" MARKDEF1(FabKey,"BHG","-",$G(OverRule)) ; Herstelling alleen kader
 Do:OpmTyp="G" MARKDEF1(FabKey,"ZFTL","-",$G(OverRule)) ; Herstelling glas
 Do:Montage="KZ" MARKDEF1(FabKey,"M","-",$G(OverRule)) ; Zonder monteren, meestal alleen kader
 Do:Montage="DV"&('$L(Vul)) MARKDEF1(FabKey,"BHG","-",$G(OverRule)) ; diverse MAAR geen glas
 Quit
 
MARKSPLT(TOENr,TLUNr,QtyOld,QtyNew,TOENr2,TLUNr2,Qty2) ; Splitsen van een toelevlijn, bij bv. het splitsen van een contract
 New FabKey,FabKey2,FRec,Node,Qty
 Set FabKey=$$FABKEYT(TOENr,TLUNr)
 Set FabKey2=$$FABKEYT(TOENr2,TLUNr2)
 Lock +^HADPR("F",FabKey)
 Set FRec=$G(^HADPR("F",FabKey))
 Quit:FRec=""  ; Geen batch of status opvolging
 Set ^HADPR("F",FabKey2)=FRec
 Set Node=""
 For  Set Node=$O(^HADPR("F",FabKey,Node)) Quit:Node=""  Do
 .Quit:Node="H"  ; Niet voor herbestelling
 .Quit:Node="AR"  ; Niet voor activatie/reservatie
 .Set FRec=^HADPR("F",FabKey,Node)
 .Quit:$P(FRec,D)<QtyNew  ; Er is onvoldoende
 .Set Qty=$P(FRec,D)-QtyNew
 .Set $P(FRec,D)=QtyNew
 .Set $P(FRec,D,3)="A" ; Partieel kan niet
 .Kill:'QtyNew ^HADPR("F",FabKey,Node) ; verwijderen
 .Set:QtyNew ^HADPR("F",FabKey,Node)=FRec ; aanpasssen
 .Quit:'Qty  ; Geen rest
 .Set $P(FRec,D)=Qty ; Restant
 .Set $P(FRec,D,3)=$S(Qty2=$P(FRec,D):"A",1:"P")
 .Set ^HADPR("F",FabKey2,Node)=FRec
 Lock -^HADPR("F",FabKey)
 Quit
 
MARKDEF1(FabKey,Types,Status,OverRule) 
 New I
 For I=1:1:$L(Types) Set:$G(OverRule)!'$D(^HADPR("F",FabKey,$E(Types,I))) $P(^HADPR("F",FabKey,$E(Types,I)),D,3)=Status
 Quit
 
MARKOMS(MarkTyp) 
 ; Omschrijving van welke markering er actief is
 New MarkOms
 Set MarkOms=$S($L(MarkTyp)=1:$F("BHhGTLZOPMVAK",MarkTyp),MarkTyp="BATCH":1,$L(MarkTyp)=2:$S(MarkTyp="FP":"Gezaagd (frontplaat)",MarkTyp="FH":"Gezaagd (frontplaat plus)",MarkTyp="BR":"Gezaagd (bodem en rug)",1:""),1:"")
 Set:MarkOms MarkOms=$P("Verander Batch;Glas besteld;Glas herbesteld onze kost;Glas herbesteld leverancier;Glas geleverd;TekeningFrezing;Zaaglijst;geZaagd;geFreesd;gePonst;geMonteerd;Verpakt;Activeer;Klaarmaken prod.",";",MarkOms)
 Quit MarkOms
 
FABKEYB(RecB) ; Bereken FABRICAGE sleutel van uit Batch record
 New Key
 Quit $$FABKEYT($P(RecB,D,6),$P(RecB,D,5))
 Quit Key
 
FABKEYT(TOENr,TLUNr) ; Berekend de FABRICAGE sleutel
 Quit TOENr_";"_(TLUNr\100*100)
 
FABKEYP(PRNr) ; Berekend de FABRICAGE sleutel via het product, opgelet er kunne dubbels zijn door "\" gescheiden
 New TOENr,TLUNr,RetStr
 Set (TOENr,TLUNr)=""
 Set RetStr=""
 For  Set TOENr=$O(^TO("IP",PRNr,TOENr)) Quit:TOENr=""  Do
 . For  Set TLUNr=$O(^TO("IP",PRNr,TOENr,TLUNr)) Quit:TLUNr=""  Do
 ..Set RetStr=RetStr_"\"_TOENr_";"_(TLUNr\100*100)
 Quit $E(RetStr,2,999)
 
FABKEYO(KLNr,ORDNr,OLUNr) ; Berekenen van de FABRICAGE sleutel vertrekkend van een order
	New OLNr,OLRec,TOENr,TLNr,LEVNr,TLUNr
 	Set:'$G(KLNr) KLNr=$P(^KO1(ORDNr,"F"),"\")
	Set OLNr=^ORD("IU",ORDNr,OLUNr)
	Set OLRec=^KOD(KLNr,"F",ORDNr,OLNr)
	Set TOENr=$P(OLRec,"\",27)
	Quit:'TOENr ""
	Set TLNr=$P(OLRec,"\",28)
	Quit:'TLNr ""
	Set LEVNr=$P($G(^KTO1(TOENr)),"\")
	Quit:LEVNr="" ""
	Set TLUNr=$P($G(^KTO(LEVNr,TOENr,TLNr)),"\",15)
	Quit:TLUNr="" ""
	Quit $$FABKEYT(TOENr,TLUNr)
	
	; KLNr, ORDNr en OLNr via .Local
OrderFromFabKey(FabKey,KLNr,ORDNr,OLNr)
	New TOENr,TLNr,TLRec
 	Set TOENr=$P(FabKey,";")
	Set TLNr=^TO("IU",TOENr,$P(FabKey,";",2))
	Set TLRec=^KTO($$$LevHalux,TOENr,TLNr)
	Set ORDNr=$P(TLRec,"\",27)
	Set OLNr=$P(TLRec,"\",28)
	Set KLNr=$S(ORDNr:$P($G(^KO1(ORDNr,"F")),"\"),1:"")
	Quit
 
 
	
IsActief(FabKey) ; Controle of een fabkey reeds geactiveerd is voor productie in HALUX
	Quit:FabKey="" 0
	Quit:$P($G(^HADPR("F",FabKey),"\\\1"),"\",4) 0 ; Onbestaande of gemarkeerd om verwijderd te worden
	Quit 1
	
	; Controle of het order of een orderlijn reeds geactiveerd is voor productie in HALUX
IsActiefOrder(ORDNr,OLUNr)
	New KLNr,OLNr,IsActief
 	Set KLNr=$P(^KO1(ORDNr,"F"),"\")
 	If $G(OLUNr) Do
	. Set IsActief=$$IsActief($$FABKEYO(KLNr,ORDNr,OLUNr))
	Else  Do
	. Set IsActief=0
	. Set OLNr=100
 	. For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do  Quit:IsActief
	. . Quit:'$P(^KOD(KLNr,"F",ORDNr,OLNr),"\",2)  ; Geen productlijn
	. . Set OLUNr=$P(^KOD(KLNr,"F",ORDNr,OLNr),"\",15)
	. . Set IsActief=$$IsActief($$FABKEYO(KLNr,ORDNr,OLUNr))
 	Quit IsActief
 	
MARK(Select,Actie) 
 ; Markeren van een lijn
 ; Actie = B (backgrnd)
 New RecO,FabKey,PRNr,RecP
 Set RecO=^HULP(%J,"L",Select)
 Set FabKey=$$FABKEYB(RecO)
 Quit:$$CheckContract(FabKey) ; Niet toelaten bij contracten
 Set PRNr=$P(RecO,D,3)
 Set RecP=$G(^HADPR("F",FabKey,MarkTyp))
 If $P(RecP,D,3)="-" Write:Actie="" *7 Quit  ; Bewerking mag niet uitgevoerd worden
 If $P(RecO,D,12)'="",Actie="" Do 
 .Set ($P(RecO,D,12),$P(RecO,D,13))=""
 Else  If "BLT"[MarkTyp!(MarkTyp="BATCH") Do
 .If $P($G(^HADPR("F",FabKey,MarkTyp)),D,3)'="A" Do
 ..Set $P(RecO,D,12)="+"
 .Else  Do
 ..Set:Actie="" $P(RecO,D,12)="-"
 Else  Do
 .If Actie=""  Do MARKWIJZ(FabKey,.RecO)
 .If Actie="B"  Do MARKWIJZ(FabKey,.RecO)
 .If Actie="W",$P(RecP,D) Set $P(RecO,D,12)="-"
 Set ^HULP(%J,"L",Select)=RecO
 If Actie=""!(Actie="W") Do
 .Do LINE^vhLIST(.LD,LD("SELECT"))
 .Do MOVE^vhLIST(.LD,"DO",0)
 Quit
 
 ; Markeren van een ganse groep (toelevering)
MARKAUTO(Actie)
 New OldRec,Prev,Next,Unmark
 Set OldRec=^HULP(%J,"L",LD("SELECT")),Prev=LD("SELECT"),Unmark=0
 ; Opzoeken van de eerste lijn van deze groep
 For  {
	 Set Prev=$O(^HULP(%J,"L",Prev),-1)
	 Quit:Prev=""
	 Quit:$P(^HULP(%J,"L",Prev),D,6)'=$P(OldRec,D,6)
 }
 ; Zijn alle lijnen van de groep niet gemarkeerd?
 Set Next=Prev
 For  {
	 Set Next=$O(^HULP(%J,"L",Next))
	 Quit:Next=""
	 Quit:$P(^HULP(%J,"L",Next),D,6)'=$P(OldRec,D,6)
	 Set Unmark=$L($P(^HULP(%J,"L",Next),D,12))
	 Quit:Unmark
 }
 ; Indien markeren, positioneren op de eerste lijn van die groep
 If 'Unmark Set LD("SELECT")=Prev+1 Do ENABLE^vhLIST(.LD,LD("SELECT"))
 
 ; Indien Unmark dan enkel die lijn toggelen, anders de ganse groep markeren
 For {
	 Do MARK(LD("SELECT"),Actie)
	 Quit:Unmark
	 Quit:$L($P(OldRec,D,12))
	 Quit:$P(^HULP(%J,"L",LD("SELECT")),D,6)'=$P(OldRec,D,6)
	 Quit:LD("SELECT")=LD("MAX")
 }
 If 'Unmark,LD("SELECT")'=LD("MAX"),$L($P(^HULP(%J,"L",LD("SELECT")),D,12)),$P(^HULP(%J,"L",LD("SELECT")),D,6)'=$P(OldRec,D,6) Set Input="+"
 Quit
 
CheckContract(FabKey)
	New TOENr,LEVNr,ORDNr,KLNr,TLNr
	Set TOENr=$P(FabKey,";")
	Set LEVNr=$P($G(^KTO1(TOENr),"*"),"\")
	Set TLNr=$G(^TO("IU",TOENr,$P(FabKey,";",2)))
	Quit:TLNr="" "Bad Key"
	Set ORDNr=$P($G(^KTO(LEVNr,TOENr,TLNr)),"\",27) ; KOM-link
	Quit:ORDNr="" "No order"
	Set KLNr=$P($G(^KO1(ORDNr,"F")),"\",1)
	Quit:KLNr="" "No klant"
	Quit $P($G(^KOD(KLNr,"F",ORDNr,1)),"\",25)="C" ; geen contracten
 
 
CheckFysStockProbleem(FabKey)
	; 0 = Probleem, 1 = Geen probleem
 	New Check,TOENr,ProdList,BSKey,PRNr,Txt,KLNm,KLNr,Btn,KortTekst
	Set TOENr=$P(FabKey,";")
	Set Check=1
	Quit:$D(^HULP(%J,"CHECK",TOENr)) ^HULP(%J,"CHECK",TOENr)
	Set FabKey2=TOENr_";"
	For  Set FabKey2=$O(^HADPR("F",FabKey2)) Quit:$P(FabKey2,";")'=TOENr  Do
	. Quit:'$D(^TO("IU",TOENr,$P(FabKey2,";",2))) ; Toeleveringslijn bestaat niet
	. Quit:$P($G(^HADPR("F",FabKey2,"K")),D,3)="A" ; Reeds volledig klaargezet
	. Quit:$P($G(^HADPR("F",FabKey2,"F")),D,3)'="A" ; Geen fysisch stock probleem
	. ; Opzoeken welk halffabrikaat het probleem heeft
	. Set BSKey=""
	. For  Set BSKey=$O(^HADPR("F",FabKey2,"AR",BSKey)) Quit:BSKey=""  Do
	. . Quit:$P($G(^HADPR("F",FabKey2,"AR",BSKey)),D,6)'="F"
	. . Set PRNr=$P(^HADPR("F",FabKey2,"AR",BSKey),D,1)
	. . Set ProdList(PRNr)=$G(ProdList(PRNr))+$P(^HADPR("F",FabKey2,"AR",BSKey),D,3)
	Quit:'$D(ProdList) 1
	If Actie="B" Quit 0
	; Opbouw text
	Set KLNr=$P($G(^KTO(LEVNr,TOENr,1)),D,8)
	If KLNr Set KLNm=$P(^KKL(^KK1(KLNr),0),D,2)
	Set Txt=0
	Set:$L($G(KLNm)) Txt($I(Txt))="      Klant :"_KLNm
	Set Txt($I(Txt))="Toelevering : "_TOENr
	Set Txt($I(Txt))="bevat fysisch stock probleem voor :"
	Set PRNr=""
	For  Set PRNr=$O(ProdList(PRNr)) Quit:PRNr=""  Do
	. Set KortTekst=$P($G(^KPR(PRNr,0),"***"_PRNr_"***"),D)
	. Set Txt($I(Txt))=$J(KortTekst,25)_" : "_$J(ProdList(PRNr),0,0)
	Set Btn($I(Btn))="Niet&0",Btn($I(Btn))="Toch opnemen&1"
	Set Check=$$WILD^vhTXTPOP("C;C","Fysisch stock probleem","Txt","Btn",2)
	Set ^HULP(%J,"CHECK",TOENr)=Check
	Quit Check
	
MARKWIJZ(FabKey,RecO) 
 New Reden
 Set sFL("P")=$G(^HADPR("F",FabKey,MarkTyp))
 Set sFL("O")=RecO
 Set Reden=$P(RecO,D,13)
 If MarkTyp="K" Do 
 . Set Qty=$S($P(sFL("P"),D,1):-$P(sFL("P"),D,1),1:$P(sFL("O"),D,7))
 . Set:Qty>0&&'$$CheckFysStockProbleem(FabKey) Qty="" ; Controle of er in de toelevering een fysisch stockprobleem is voor een halffabrikaat
 Else  Do  ; Bij K (=Klaarzetten) is het alles of niets
 . Set Qty=$P(sFL("O"),D,7)-$P(sFL("P"),D,1)
 . Set:Qty<0 Qty=0
 . Do NIEUW^vhScherm("HADOPVMARK",,,,"NEWAANTAL",,3,"A")
 If Qty Set $P(RecO,D,12)=Qty
 Set $P(RecO,D,13)=Reden
 Set:Qty=$P(sFL("O"),D,7) $P(RecO,D,12)="+" ; Volledig selecteren
 Set:Qty=-$P(sFL("O"),D,7) $P(RecO,D,12)="-" ; Volledig verwijderen
 Quit
 
MARKALL(Set) 
 For Select=1:1:$O(^HULP(%J,"L",""),-1) Do
 .Do MARK(Select,Set)
 Do REFRESH
 Quit
 
MARKPOP
 Do CALLSPEC^vhMenu("HADOPVM2") 
 Quit
 
MARKBEG(Mode)  ; Markeringstype opslaan
 If $L(Batches,";")>1&(Mode'="BATCH")&("AKGBFTPZMV"'[Mode) Do WARN^vhTXTPOP("Meerdere batches door elkaar~dan is markering niet mogelijk") Quit
 If $G(MarkTyp)'="" Do MARKEND(1)
 Quit:$G(MarkTyp)'=""
 Set MarkTyp=Mode
 If MarkTyp="K" Do SCAN^MRPRES ;Reservatie controleren van alle producten VOOR het klaarzetten
 Kill ^HULP(%J,"CHECK") ; Verwijder Toeleveringslijst voor $$CheckFysStockProbleem
 Do REFRESH
 Quit
 
MARKCONT New MarkMem,DERDE,X
 Set MarkMem=MarkTyp
 Do MARKEND(0)
 Set DERDE("L")=LEVNr,DERDE("N")=1
 Set X=$$SELECT^FLOW("KTO","KTO1",1,.DERDE,.DERDE)
 Quit:'X
 Set TOENr=X
 Do INIT,FETCH
 Set MarkTyp=MarkMem
 Do REFRESH
 ;Do MARKALL("S")
 Quit
 
MARKEND(Ask) ; Uitvoeren van de gemarkeerde lijnen volgens het markeringstype
 New Inp,I
 If $G(MarkTyp)="" Quit
 Set I=$F("B ZT F GH",MarkTyp)
 If MarkTyp="BATCH" Do
 .Set Batch=$$BATCHPOP^HADBATCH("NV")
 .Quit:Batch=""
 .Set Batch=$P(Batch,";") ; Soms wordt een ganse lijst van batches doorgegeven
 .Do BATCHPUT(Batch),MODTOE^HADBATCH(Batch)
 If $L(MarkTyp),"BGHhTLZFPMVAKFHBRO"[MarkTyp Do
 .Set Inp=$S(Ask:$$^vhTXTPOP("HADOPV","MARKEND",,$$MARKOMS(MarkTyp)),1:1)
 .If Inp="W" Do MARKALL(0)
 .Quit:'Inp
 .Do MARKPUT(MarkTyp)
 .Do:MarkTyp="L" ZAAGL^HADOPV2(Batches)
 Set MarkTyp=""
 Do INIT,FETCH,REFRESH
 Kill ^HULP(%J,"CHECK") ; Verwijder Toeleveringslijst van $$CheckFysStockProbleem
 Quit
 
MARKPUT(Node) ;Opslaan van de markering in de HADPR
 New Select,RecO,PRNr,Time,RecP,GVORDNr,NewQty,BldQty,FabKey,CRef,Status,GenType,Reden
 ;Do NIGHT^MRPRES ; Reservatie herberekenen
 Set CRef=$$OPEN^MRPRES()
 Do OpenLabel(.LabelCache)
 Set Time=$H
 Set GVORDNr=""
 For Select=1:1:$O(^HULP(%J,"L",""),-1) Do
 . Set RecO=^HULP(%J,"L",Select)
 . Set FabKey=$$FABKEYB(RecO)
 . Quit:$P(RecO,D,12)=""
 . Set PRNr=$P(RecO,D,3)
 . Set NewQty=$P(RecO,D,12)
 . Set Reden=$P(RecO,D,13)
 . Set BldQty=$P(RecO,D,7)
 . Set GenType=$$GENTYP^HAD(PRNr)
 . If $$HeeftHalfFabr(PRNr) Do  ; Heeft halffabrikaten
 .. If Node="A" Do  ; Activering/Reservering
 ...  Set NewQty=$$MARKPR(FabKey,Node,NewQty,BldQty,Time) ; eerst markeren dan status
 ...  Do ONERES^MRPRES(CRef,FabKey,PRNr,BldQty,"FPWT",.Status)
 .. Else  If Node="K" Do  ; Productie klaarmaken
 ...  Do ONEPK^MRPRES(CRef,FabKey,PRNr,BldQty,.Status)
 ...  Set:$P($G(^HADPR("F",FabKey,"X")),D,3)'="A" NewQty=$$MARKPR(FabKey,Node,NewQty,BldQty,Time)
 .. Else  If "\FP\FH\BR\"[(D_Node_D) Do
 ...  Do MARK^MRPHalfFabrStock(FabKey,Node)
 ...  Set NewQty=$$MARKPR(FabKey,Node,NewQty,BldQty,Time)
 . Else  If (Node="B"!(Node="H")!(Node="h")),$$GENTYP^HAD(PRNr)'["KAD\MDS" Do  ; Bestelling of herbestelling van Kaderdeuren behalve voor MDS
 .. New TOENr,TULNr
 .. Set TOENr=$P(RecO,D,6)
 .. Set TULNr=$P(RecO,D,5)
 .. Set RecP=$G(^HADPR("F",FabKey,Node))
 .. Set OldQty=$P(RecP,D)
 .. Set NewQty=$S(NewQty="-":-OldQty,NewQty="+":BldQty,1:NewQty)
 .. Do ADDGLAS^HADVUL(.GVORDNr,PRNr,TOENr,TULNr,+$H,NewQty,BldQty,$S(Node="H":"H",Node="h":"L",1:""),Reden)
 . Else  Do ; glasbesteld of herbesteld ook markeren voor MDS 
 .. Set KLNr=$P(RecO,D,2)
 .. Do AddLabel(.LabelCache,Node,FabKey,NewQty,BldQty,PRNr,KLNr) ; glasbesteld dan moet er een label afgedrukt worden
 .. Set NewQty=$$MARKPR(FabKey,Node,NewQty,BldQty,Time)
 Do CLOSE^MRPRES(CRef)
 If $D(LabelCache) Do PrintLabel(.LabelCache)
 Quit
 
OpenLabel(LabelCache)
	; LabelCache via .Local
	Kill LabelCache
	Quit
 
AddLabel(LabelCache,Node,FabKey,NewQty,BldQty,PRNr,KLNr)
	; LabelCache via .Local
	New Rec
	Quit:$$GENTYP^HAD(PRNr)["KAD\MDS"
	Quit:Node'="T"
	Quit:NewQty="-"
	Quit:NewQty<0
	If NewQty="+" Set NewQty=BldQty
	Set LabelCache(FabKey)=$LB(Node,NewQty,BldQty,PRNr,KLNr)
	Quit
 
PrintLabel(LabelCache)
	; LabelCache via .Local
	; Set StandaardLayout="10x10"
	Set StandaardLayout="5x10"
    Set blLabelPrinter=##class(BL.Sys.LabelPrinter).%New()
    ;Do blLabelPrinter.Devices(.PrinterLijst,StandaardLayout)
    ;If PrinterLijst=1 Do
    ;.Set Printer=PrinterLijst(1) ;als er maar één printer is dan wordt deze printer automatisch geselecteerd
    ;Else  Do
    ;.Set Printer=$$WILD^vhPOPUP("C;C","O1-","Selecteer een printer",.PrinterLijst) 
    
    Set Printer="HALUX_PRODUCTIE_KELLER" ; steeds dezelfde printer
    Quit:Printer=""
    Set PrinterURL=##class(BL.Sys.LabelPrinter).FullDevicePad(Printer)
    ;
	Kill ^HULP(%J,"Label")
    Set FabKey=""
    For  Set FabKey=$O(LabelCache(FabKey)) Quit:FabKey=""  Do
    . Set TOENr=$Piece(FabKey,";")
    . Set VNR=$Piece(FabKey,";",2)
    . Set Rec=LabelCache(FabKey)
    . Set NewQty=$LI(Rec,2)
    . Set BldQty=$LI(Rec,3)
    . Set PRNr=$LI(Rec,4)
    . Set KLNr=$LI(Rec,5)
    . If '$D(^HULP(%J,"Label",TOENr)) Do
    . . Set LevNr=$Piece($G(^KTO1(TOENr)),D)
    . . Set KlantIndex=^KK1(KLNr)
    . . Set KlantNaam=$Piece(^KKL(KlantIndex,0),"\",2)
    . . Set XX=KlantNaam_D_LevNr
    . Else  Do
    . . Set XX=^HULP(%J,"Label",TOENr)
    . . Set LevNr=$P(XX,"\",2)
    . If LevNr'="" Do
    . . Set Gevonden=0,TULNr=100
    . . For  Set TULNr=$O(^KTO(LevNr,TOENr,TULNr)) Quit:TULNr=""!Gevonden  Do
    . . . Set xLijn=^KTO(LevNr,TOENr,TULNr)
    . . . If $P(xLijn,D,2)=PRNr Set Gevonden=1,Week=$Piece(xLijn,"\",19)
    . Else  Set Week=""
    . Set DossierNr=$Piece($Get(^KPR(PRNr,"G")),"\")
    . Set Opmerking=$S($D(^HADPR("F",FabKey,"H"))!$D(^HADPR("F",FabKey,"L")):"Herstelling",1:"")
    . If Week="" Set Week="9/41"
    . If Week'="" Do
    . . Set Datum=$$FormatDateTime^vhLib("ddd dd/mm/yy",$$INTDATE^vhDTyp(Week,"DW"))
    . Else  Set Datum=""
    . Set $Piece(XX,"\",3)=$Piece(XX,"\",3)+1
    . Set $Piece(XX,"\",4)=$Piece(XX,"\",4)+BldQty
    . Set ^HULP(%J,"Label",TOENr)=XX
    . Set ^HULP(%J,"Label",TOENr,VNR)=NewQty_"\"_BldQty_"\"_DossierNr_"\"_Datum_"\"_Opmerking
	
	Set TOENr=""
	For  Set TOENr=$O(^HULP(%J,"Label",TOENr)) Quit:TOENr=""  Do
	. Set XX=^HULP(%J,"Label",TOENr)
	. Set KlantNaam=$Piece(XX,"\",1)
	. Set AantalArtikels=$Piece(XX,"\",3)
	. Set TotToelevering=$Piece(XX,"\",4)
	. ;Set LeveringAantal=$S(TotToelevering'=TotProductie:TotProductie_"/"_TotToelevering,1:"")
	. Set LeveringAantal="Bevat "_AantalArtikels_" producttypes/ "_TotToelevering_" kaders in tot."
	. Set VNR="" 
	. For  Set VNR=$O(^HULP(%J,"Label",TOENr,VNR)) Quit:VNR=""  DO
	. . Set Rec=^HULP(%J,"Label",TOENr,VNR)
	. . Set pxLabel=##class(BL.PPS.KAD.sub.pxKADPlanning).%New()
	. . Set pxLabel.Toeleveringsnummer=TOENr
	. . Set pxLabel.AantalToelevering=LeveringAantal
	. . Set pxLabel.KlantNaam=KlantNaam
	. . Set Aantal=$Piece(Rec,"\")
	. . Set Productie=$Piece(Rec,"\",2)
	. . Set pxLabel.AantalProduct=$S(Productie'=Aantal:"Ontvangen: "_Aantal_"/ Besteld: "_Productie,1:"")
	. . Set pxLabel.DossierNr="Producttype: "_$Piece(Rec,"\",3)
	. . Set pxLabel.Leverdatum=$Piece(Rec,"\",4)
	. . Set pxLabel.Opmerking=$Piece(Rec,"\",5)
	. . ;geërfde eigenschappen
	. . Set pxLabel.Taal="N"
    . . Set pxLabel.Aantal=1
    . . Set pxLabel.Layout="Halux Opvolging 5x10_2"
    . . Set pxLabel.Device=PrinterURL
    . . Do blLabelPrinter.Add(pxLabel)
    . . ;Do blLabelPrinter.PrintDirect2Bartender(pxLabel,0)
    Do blLabelPrinter.Print2Bartender(0)
    Kill LabelCache
	Quit
 
MARKGLAS(PRNr,TOENr,TLNr,Qty,MaxQty,Rede,Ref) ; Wordt opgeroepen van uit HADVUL
 Set Rede=$S(Rede="L":"h",Rede="":"B",1:Rede)
 Set X=$$MARKPR($$FABKEYT(TOENr,TLNr),Rede,Qty,MaxQty,$H,Ref) Quit
 Quit
 
MARKPR(FabKey,Node,NewQty,MaxQty,Time,Ref) 
 New RecP,I,OldQty
 Lock +^HADPR("F",FabKey)
 Set:Node="h" Node="H"
 Set RecP=$G(^HADPR("F",FabKey,Node))
 Set OldQty=$P(RecP,D)
 Set NewQty=$S(NewQty="-":-OldQty,NewQty="+":MaxQty,1:NewQty)
 For I=11:2:20 Quit:$P(RecP,D,I)=""
 Set $P(RecP,D,I)=OldQty
 Set $P(RecP,D,I+1)=$P(RecP,D,2) ; old time
 Set NewQty=OldQty+NewQty
 Set $P(RecP,D,1)=NewQty
 Set $P(RecP,D,2)=Time
 Set $P(RecP,D,3)=$S('NewQty:"",NewQty'<MaxQty:"A",1:"P")
 Set $P(RecP,D,4)=$G(Ref)
 Set ^HADPR("F",FabKey,Node)=RecP
 Lock -^HADPR("F",FabKey)
 Quit NewQty
 
BATCHPUT(Batch) ;Opslaan van de nieuwe batch code
 New Select,RecP,RecO,PRNr,Time,FabKey
 For Select=1:1:$O(^HULP(%J,"L",""),-1) Do
 .Set RecO=^HULP(%J,"L",Select)
 .Set FabKey=$$FABKEYB(RecO)
 .Quit:$P(RecO,D,12)'="+"
 .Set PRNr=$P(RecO,D,3)
 .Lock +^HADPR("F",FabKey)
 .Set RecP=$G(^HADPR("F",FabKey))
 .Set $P(RecP,D)=Batch
 .Set ^HADPR("F",FabKey)=RecP
 .Lock -^HADPR("F",FabKey)
 .;Opzoeken record en verplaatsen
 .Set OldBat=$P(RecO,D,8)
 .Set VolgNr=""
 .For  Set VolgNr=$O(^HADPR("O",OldBat,VolgNr)) Quit:VolgNr=""  Do
 ..Set Rec=^(VolgNr)
 ..Quit:$P(Rec,D,1,8)'=$P(RecO,D,1,8)
 ..Set $P(Rec,D,8)=Batch
 ..Kill ^HADPR("O",OldBat,VolgNr)
 ..Set VolgNr=$O(^HADPR("O",Batch,""),-1)+1
 ..Set ^HADPR("O",Batch,VolgNr)=Rec
 ..Set VolgNr=99999
 Quit
 
NEXTBAT(Dir) 
 Set Batch=$O(^HADPR("B",$P(Batches,";")),Dir)
 If Batch="" Write *7 Quit
 Set Batches=Batch
 Do INIT,FETCH,REFRESH
 Quit
 
TOELEV New Actie
 New TR,Locals
 Set (Locals("TOENr"),TR)=$P(FabKey,";"),Locals("Extern")=1
 Do DO^vhPROGRAM("FTE^KTO30","","",$G(NoMod))
 Do REFRESH
 Quit
 
RPLKL New Actie
 Quit:'KLNr
 Set Actie=$$RAADPL^KLANT(KLNr,"O")
 Do REFRESH
 Quit
 
RPLPR New Actie
 Quit:'PRNr
 Set Actie=$$RAADPL^PRODUKT(PRNr,"1")
 Do REFRESH
 Quit
 
RPLWIZ New Actie
 Quit:'PRNr
 Do DISPLAY^HADWIZ(PRNr,1)
 Quit
 
 ; Opvragen en snijden van het aantal overdozen
SnijOverdoos(PRNr,Aantal)
 New %SC,OverDoos,OverDozen,StuksPerDoos
 Set OverDozen=Aantal
 Do DISPLAY^vhScherm("HADOPVSOVD")
 Do FIELD^vhScherm("HADOPVSOVD","DOZEN")
 Do:%SC
 . Set OverDozen=$TR(OverDozen,";:/.",",,,,")
 . For OverDoos=1:1:$L(OverDozen,",") Do
 . . Set StuksPerDoos=$P(OverDozen,",",OverDoos)
 . . Do ##class(BL.PPS.KAD.OptiBox).%New().SnijOne(PRNr,StuksPerDoos,1,"", ,9,1,"HALUX")
 Do WRITE^vhLIST(.LD)
 Quit
 
 ; Controle ingave overdozen tov het oorspronkelijk aantal
ValOverdoos(OverDozen,Aantal)
 New sEr,OverDoos,CumulDozen
 Set sEr="Foutieve ingave"
 Set OverDozen=$TR(OverDozen,";:/.",",,,,")
 If $L($TR(OverDozen,",0123456789",""))
 Else  If $E(OverDozen)=","
 Else  If $E(OverDozen,$L(OverDozen))=","
 Else  If OverDozen[",,"
 Else  Do  ; De ingave is correct, nu nog de aantallen vergelijken
 . Set CumulDozen=0
 . For OverDoos=1:1:$L(OverDozen,",") Set CumulDozen=CumulDozen+$P(OverDozen,",",OverDoos)
 . If CumulDozen=Aantal Set sEr="" Quit
 . Set sEr=$$^vhTXTPOP("HADOPV","SNIJOVERDOOS","",CumulDozen,$S(CumulDozen>Aantal:"groter",1:"kleiner"),Aantal)
 Quit sEr
 
 ; Automatisch markeren van toeleveringslijnen
AutoMarkOn
 New %SC,Beperking,Datum,DagDeel,Next
 Set Beperking=$P(LimRec,D,12),Datum=$$CALCDATE^vhDTyp(,"A",+Beperking),DagDeel=$E(Beperking,$L(Beperking))
 Set:Datum="" Datum=+$H Set:DagDeel="" DagDeel="N"
 Do NIEUW^vhScherm("HADOPVBEPTRM",,,,,,3,"A")
 If %SC {
	 Set AutoMark=1,Batches="TX ;TP "
	 If 'Datum Set Beperking=""
	 Else  Set Beperking=Datum_$S(DagDeel="V":",43200",1:"")
	 Set DispMode="O"
	 Do REFRESH^HADSTAT2(LEVNr,"T")
	 Set $P(LimRec,D,12)=Beperking,(ORDNr,TOENr,FabKeyGlobRef)=""
	 Kill ^HULP(%J)
	 Do INIT,FETCH
	 Do MARKBEG("K")
	 Set (Next,LD("SELECT"))=""
	 ; Alle lijnen proberen te markeren
	 For  {
		 Set Next=$O(^HULP(%J,"L",Next))
		 Quit:Next=""
		 Do MARK(Next,"B")
		 If 'LD("SELECT"),'$L($P(^HULP(%J,"L",Next),D,12)) Set LD("SELECT")=Next
	 }
	 Set:'LD("SELECT") LD("SELECT")=1
	 Do REFRESH
 }
 Quit
 
AutoMarkOff
 Kill AutoMark
 Do MARKEND(1)
 Quit
 
 ; Zoek volgende te behandelen lijn
FindNext
 New OldSelect,OldRec
 If $D(^HULP(%J,"L",LD("SELECT"))) {  ; Indien geen lege lijst
	 Set OldSelect=LD("SELECT"),OldRec=$G(^HULP(%J,"L",OldSelect))
	 ; Zoek in alle volgende lijnen
	 For  {
		 Set LD("SELECT")=$O(^HULP(%J,"L",LD("SELECT")))
		 Quit:LD("SELECT")=""
		 If '$L($P(^HULP(%J,"L",LD("SELECT")),D,12)),$P(^HULP(%J,"L",LD("SELECT")),D,6)'=$P(OldRec,D,6) Quit
	 }
	 ; Indien niet gevonder, zoek in alle voorgaande lijnen
	 If LD("SELECT")="" {
		 For  {
			 Set LD("SELECT")=$O(^HULP(%J,"L",LD("SELECT")))
			 Quit:LD("SELECT")=OldSelect
			 Quit:'$L($P(^HULP(%J,"L",LD("SELECT")),D,12))
		 }
	 }
	 Do:LD("SELECT")'=OldSelect ENABLE^vhLIST(.LD,LD("SELECT"))
 }
 Quit
 
HeeftHalfFabr(PRNr)
 Quit:'PRNr 0
 New GenType
 Set GenType=$$GENTYP^HAD(PRNr)
 Quit ($P(GenType,"\")'?1(1"KAD",1"PRF",1"GLA"))&&$$HasHalfFabr^PRBS(PRNr)