FLOWTOE ;Toelevering [ 07/02/2002  2:59 PM ]
#include BL.Derde.LevSpecifiek
 ;;;
 New TLNr,LEVNr,Input,Detail,DefLevT,PrCount,AD,ScrolToe,Help,LevMunt,MoveTLNr
 Do INIT
 Do BLDDEVSAVE^FLOWTOE6(TLNr)
 Do COMMAND
 Do CHKDEVSAVE^FLOWTOE6(TLNr)
 Do DELDEVSAVE^FLOWTOE6
 Do CHKDEL(TLNr)
 Kill EwmsLink
 Quit
 ;
COMMAND 
 Do:$G(AutoToe)
 .If $L($G(EDIORDNr)),$D(^MBLOG("EDI",KLNr,+EDIORDNr,EDIORDNr)) Do
 ..Do IMPTOE^ATKEDI(LEVNr,TLNr,EDIORDNr)
 ..Set Input="S"
 ..Set Input="" ; Automatisch sluiten afgesloten
 .Do:$D(PRNr) AUTOTOE^FLOWTOE3
 Do RESET^vhScherm
 For  Do  If Input="-" Do SORT(),TSPLIT(TLNr) Quit
 .Set ScrolToe=1
 .Do REFRESH
 .If USC=""!'Help Set FP=$P(UD,D,2)+1*100+1 Write @F,@F1
 .Else  Do HELP^FLOW
 .Set Help=1
 .Set DL(2)="\[31~;SPEC"
 .If $L(Input) Set R=Input
 .Else  Do SL^PROC
 .Set Input=R
 .If Input="COM" Do MENU
 .If Input="SPEC" Do SPEC
 .Kill A,B
 .If $L(Input),Input'="-",LEVNr'=$$$LevHalux Do  Quit:Input=""
 ..New R,LWarn,LMax
 ..;Set UZ=^KTO(LEVNr,TLNr,0)-100,LWarn=60,LMax=70
 ..Set UZ=^KTO(LEVNr,TLNr,0)-100,LWarn=110,LMax=120
 ..If UZ>LWarn,UZ'>LMax,"\.\T\Z\I\S\"[(D_Input_D) Set R=$$^vhTXTPOP("FLOW","WARNLINES",,UZ,LMax)
 ..If UZ>LMax,"\V\A\L\"'[(D_Input_D),'$$^vhTXTPOP("FLOW","MAXLINES",,UZ,LMax) Set Input=""
 .If Input="." Do LINSERT("P") Set Help=K="-" Quit
 .If Input="T" Do LINSERT("T") Set Help=K="-"
 .If Input="-" Quit
 .Do EXEC^vhMenu("FLOWTOE",.Input)
 .If Input="HELP" Set (USC,TSC)=^KTO(0,"TSC")
 .If $L(Input)=1,"ALPW"[Input Do LMODIFY(Input)
 .If Input="AL" Do AMODIFY(Input)
 .If Input="Z" Do DEUR
 .If Input="TL" Do TMOVE
 .If Input="D" Do RPLPR
 .If Input="H" Do HOOFDING()
 .If Input="I" Do LINSERT("","B")
 .If Input="R" Do SORT(),FETCHDET,WL^PROC
 .If Input="S" Do LSPLIT
 .If Input="V" Do LDELETE
 .If Input="X" Do DELETE Set Input=$S($G(K)="-":"",1:"-") Quit
 .If Input="J" Do ORDER Quit
 .If Input="E" Do NEWPROD^FLOWTOE2
 .If Input="KK" Do KILLKOML^FLOWTOE2
 .If Input?.N,Input>0 Do HOOFDING(Input)
 .If Input=">"!(Input="<") Do SWAP^FLOWTOE2(Input)
 .If Input="RL" Do MLRECALC(LEVNr,TLNr,Detail(@DL(1)@(6)),1)
 .If Input="RT" Do RECALC(TLNr,1)
 .If Input="PRINT" Do PRINT
 .Set Input=""
 Quit
 ;
INSERT(Rec,Insert,TLLNr,Show) 
 Do INSERT^FLOWTOE2(Rec,Insert,$G(TLLNr),$G(Show))
 Quit
 ;
 ; Insert produkt
PINSERT(Insert,Line,PRNr,Aantal,Prijs,Korting1,Korting2,LevTerm,Show) 
 New R
 Set Insert=$G(Insert),Line=$G(Line)
 Set PRNr=$G(PRNr),Aantal=$G(Aantal),Prijs=$G(Prijs)
 Set Korting1=$G(Korting1),Korting2=$G(Korting2),LevTerm=$G(LevTerm)
 Set R="PINSERT^FLOWTOE2(Insert,Line,PRNr,Aantal,Prijs,Korting1,Korting2,LevTerm"
 Set:$D(Show) R=R_",Show" Set R=R_")"
 Do @R
 Quit
 ;
 ; Insert Tekst
TINSERT(Insert,Line,Text,Show,BlockId) 
 New R
 Set Insert=$G(Insert),Line=$G(Line),Text=$G(Text)
 Set R="TINSERT^FLOWTOE2(Insert,Line,Text"
 Set R=R_"," Set:$D(Show) R=R_"Show" Set:$D(BlockId) R=R_",BlockId" Set R=R_")"
 Do @R
 Quit
 ;
LINSERT(Type,Insert) 
 Do LINSERT^FLOWTOE2(Type,$G(Insert))
 Quit
 ;
LMODIFY(Input,Default,OrdLevT) 
 Quit:'$D(Detail)
 Set K=^KTO(LEVNr,TLNr,Detail(@DL(1)@(6)))
 If $P(K,D,17)="KTO11" Do WIJZIG^FLOWTEXT(Q_UGL,TLNr,Detail(@DL(1)@(6)),$ZN) Quit
 Do
 .If Input'="P",LEVNr'=6332,$$CHECKWMS^FLOW(TLNr,Detail(@DL(1)@(6)),,,,,1) Quit
 .Set Default=$G(Default)
 .Do SCROL^KTWL(Detail(@DL(1)@(6)),Input,Default)
 If @DL(1)@(6)=@DL(1)@(9) Do EL^PROC Quit
 Set DL(2)="DO" Do ML^PROC Kill DL(2)
 Quit
 ;
 ; Wijzig alle lijnen
AMODIFY(Input) 
 New R,TLLNr,Default,OrdLevT
 Quit:'$D(Detail)
 Set Input=$E(Input,2)
 Quit:Input'="L"
 If Input="L" Do
 .Do DL^PROC
 .Set Default=$$DEFAULT^KTWL1(Input)
 .Do EL^PROC
 Quit:Default="-"
 Set TLLNr=100
 For  Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr=""  Do  Quit:$D(OrdLevT)
 .Set R=^KTO(LEVNr,TLNr,TLLNr)
 .Quit:Default=$P(R,D,25)!'$P(R,D,27)
 .Set OrdLevT=$$ORDLEVT^KTWL1(Default,R)
 Set DL(2)="HO" Do ML^PROC Kill DL(2)
 For  Do  If @DL(1)@(6)=@DL(1)@(9) Do  Quit
 .If '$P(^KTO(LEVNr,TLNr,Detail(@DL(1)@(6))),D,2) Set DL(2)="DO" Do ML^PROC Kill DL(2) Quit
 .Do LMODIFY(Input,Default,$G(OrdLevT))
 Quit
 ;
 ; Sorteer volgens boom
SORT(First,Last) 
 New R,%J,TLLNr,Count,PRNr,Key,Next,NewRef,OldRef
 Quit:$O(^KTO(LEVNr,TLNr,100))=""  Quit:$P(^KTO(LEVNr,TLNr,1),D,8)=1239  ; Niet voor Keller
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set:'$G(First) First=101 Set:'$G(Last) Last=^KTO(LEVNr,TLNr,0)-1
 Set TLLNr=First-1,Count=0
 For  Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr>Last!'TLLNr  Do
 .Set R=^KTO(LEVNr,TLNr,TLLNr),PRNr=$P(R,D,2)
 .If 'PRNr Set Count=Count+1,Key=""
 .Else  Set Key=$$SORTKEY^PRODUKT(PRNr)
 .Set ^HULP(%J,$J(Count,3)_" "_Key_" "_TLLNr)=TLLNr
 Set Next="",NewRef=100
 For  Set Next=$O(^HULP(%J,Next)) Quit:Next=""  Do
 .Set NewRef=NewRef+1
 .Set OldRef=^(Next)
 .Quit:OldRef=NewRef
 .Do LSWAP^FLOWTOE2(TLNr,OldRef,NewRef)
 .Set Key=Next
 .For  Set Key=$O(^HULP(%J,Key)) Quit:Key=""  Do
 ..Set:^(Key)=NewRef ^(Key)=OldRef
 ;Set Next=$O(^KTO(LEVNr,TLNr,""),-1)+1,^KTO(LEVNr,TLNr,0)=Next
 Kill ^HULP(%J)
 Quit
 ;
 ; Verwijder een lijn
LDELETE 
 New KLNr,ORDNr,OLNr,KlOLNr
 Quit:'$D(Detail)
 Set K=^KTO(LEVNr,TLNr,Detail(@DL(1)@(6))),ORDNr=$P(K,D,27)
 If ORDNr Do  Goto EDELETE:$L($G(KlOLNr))
 .Set OLNr=$P(K,D,28),K=^KO1(ORDNr,"F"),KLNr=$P(K,D)
 .Set K=^KOD(KLNr,"F",ORDNr,OLNr),KlOLNr=$P(K,D,35)
 If $P(K,D,17)="KTO11" Do DELETE^FLOWTEXT(Q_UGL,TLNr,Detail(@DL(1)@(6))) Quit
 If $$CHECKWMS^FLOW(TLNr,Detail(@DL(1)@(6)),,,,,,1) Set K="-" Quit
 Set K=$$KEYL^vhINP("FLOWTOE","LDELETE")
 Quit:K'="V"
 Set K=^KTO(LEVNr,TLNr,Detail(@DL(1)@(6)))
 Do:$P(K,D,2) PRCOUNT^FLOW("-","KTO")
 Do DELLINE(TLNr,Detail(@DL(1)@(6))),DELETE^PROC3
 Quit
 ;
 ; Verwijder een EDI-lijn
EDELETE 
 New KLNr,PRNr,ORDNr,OLNr,BlockId,KlOLNr,KlNaam,DelEdi,TLLNr
 Quit:'$D(Detail)
 Set TLLNr=Detail(@DL(1)@(6)),DelEdi="L"
 If $$CHECKWMS^FLOW(TLNr,TLLNr,,,,,,1) Set K="-" Quit
 Set K=^KTO(LEVNr,TLNr,TLLNr),ORDNr=$P(K,D,27),OLNr=$P(K,D,28)
 If $$CHECKWMS^FLOW(,,ORDNr,OLNr,,,,1) Set K="-" Quit
 Set K=^KO1(ORDNr,"F"),KLNr=$P(K,D)
 Set K=^KOD(KLNr,"F",ORDNr,OLNr),KlOLNr=$P(K,D,35),TLLNr=100
 For  Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr=""  Do  Quit:DelEdi="G"
 .Set K=^KTO(LEVNr,TLNr,TLLNr),PRNr=$P(K,D,2),ORDNr=$P(K,D,27)
 .Quit:'PRNr  Quit:'ORDNr
 .If $$CHECKWMS^FLOW(TLNr,TLLNr,,,,,,1) Set DelEdi="G" Quit
 .Set OLNr=$P(K,D,28),K=^KOD(KLNr,"F",ORDNr,OLNr)
 .Quit:$P($P(K,D,35),".")'=$P(KlOLNr,".")  Quit:$P($P(K,D,35),".",3)'=$P(KlOLNr,".",3)
 .Set:$$CHECKWMS^FLOW(,,ORDNr,OLNr,,,,1) DelEdi="G"
 If DelEdi="G" Do  Quit:K="-"
 .Set KlNaam=$P(^KKL(^KK1(KLNr),0),D,2)
 .Set DelEdi=$$TXTPOP^FLOW("WMSDELEDI",,$$EXTNUM^vhDTyp(ORDNr,0,".",0),KlNaam)
 .Set:DelEdi="A" K="-"
 Else  Do  Quit:K="-"
 .Set K=$$KEYL^vhINP("FLOWTOE","EDELETE")
 .Quit:K'="V"
 .Set DelEdi="L"
 If DelEdi="G" Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr),-1)
 Else  Set TLLNr=100,DL(2)="HO" Do ML^PROC Kill DL(2)
 For  Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr=""  Do  Quit:DelEdi="G"
 .Set K=^KTO(LEVNr,TLNr,TLLNr),PRNr=$P(K,D,2),ORDNr=$P(K,D,27)
 .If 'PRNr!'ORDNr Set DL(2)="DO" Do ML^PROC Quit
 .Set OLNr=$P(K,D,28),K=^KOD(KLNr,"F",ORDNr,OLNr)
 .If $P($P(K,D,35),".")=$P(KlOLNr,"."),$P($P(K,D,35),".",3)=$P(KlOLNr,".",3)
 .Else  Set DL(2)="DO" Do ML^PROC Quit
 .If $$CHECKWMS^FLOW(TLNr,TLLNr,,,,,,1) Set DL(2)="DO" Do ML^PROC Quit
 .If $$CHECKWMS^FLOW(,,ORDNr,OLNr) Set DL(2)="DO" Do ML^PROC Quit
 .Do DELLINE(TLNr,TLLNr),DELETE^PROC3
 .Set OLNr=100
 .For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do
 ..Set K=^KOD(KLNr,"F",ORDNr,OLNr)
 ..Quit:'$P(K,D,2)  Quit:$P(K,D,27)
 ..Quit:$P($P(K,D,35),".")'=$P(KlOLNr,".")  Quit:$P($P(K,D,35),".",3)'=$P(KlOLNr,".",3)
 ..Do DELLINE^FLOWORD(ORDNr,OLNr,1)
 Quit
 ;
 ; Verwijder volledig de toelevering
DELETE  
 If $$CHECKWMS^FLOW(TLNr,,,,,,,1) Set K="-" Quit
 Do DL^PROC
 Set K=$$ASKL^vhINP("FLOWTOE","DELETE")
 If K'="V" Do EL^PROC Quit
 Do DELOBJ(TLNr)
 Quit
 ;
DELLINE(TLNr,TLLNr) 
 Do DELLINE^FLOWTOE3(TLNr,TLLNr)
 Quit
 ;
DELOBJ(TLNr) 
 Do DELOBJ^FLOWTOE3(TLNr)
 Quit
 ;
CHKDEL(TLNr) 
 Do CHKDEL^FLOWTOE3(TLNr)
 Quit
 ;
BUILDOBJ(PRNr,ToeRef,BackGrnd,EDIORDNr,FBRef) 
 Set ToeRef=$G(ToeRef,"STOCK")
 Do BUILDOBJ^FLOWTOE3(.PRNr,ToeRef,$G(BackGrnd),$G(EDIORDNr),$G(FBRef))
 Quit
 ;
 ; Deuren
DEUR 
 Do:"\5810\6092\6428\"[(D_LEVNr_D) SERIE^DEUR("",LEVNr,"CBDEUR^FLOWTOE")
 Quit
 ;
CBDEUR(PRNr) 
 Do PINSERT("","",PRNr,"","","","",$G(DefLevT))
 Set FP=$P(UD,D,2)+1*100+1 Write @F,@F1
 Quit
 ;
 ; Splits lijn
LSPLIT 
 New B,R
 Quit:'$D(Detail)
 If $$CHECKWMS^FLOW(TLNr,Detail(@DL(1)@(6)),,,,,1) Quit
 Do SCROL^KTSPLIT(Detail(@DL(1)@(6)))
 If K="-" Set Input=""
 Else  Do FETCHDET,WL^PROC Set DL(2)="DO" Do ML^PROC Kill DL(2)
 Quit
 ;
RPLPR 
 New R,PR
 Quit:'$D(Detail)
 Set R=^KTO(LEVNr,TLNr,Detail(@DL(1)@(6))),PR=$P(R,D,2) Quit:'PR
 Goto RPLPR^FLOW
 ;
ORDER 
 New ORDNr
 Set Input=""
 Quit:'$D(Detail)
 Set ORDNr=$$ORDNR()
 Quit:'$G(ORDNr)
 Set Goto="FOE^KF9",Locals("ORDNr")=ORDNr,Locals("Goto")=Goto
 If $D(Extern) Set Locals("Extern")=Extern
 Set Input="-"
 Quit
 ;
ORDNR() 
 New R,Rec,TLLNr,ORDNr
 Set Rec=^KTO(LEVNr,TLNr,Detail(@DL(1)@(6)))
 Set TLLNr=100
 For  Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr=""  Do
 .Set R=^KTO(LEVNr,TLNr,TLLNr)
 .If $P(R,D,27) Set ORDNr($P(R,D,27))=$P(R,D,27)
 If $O(ORDNr($O(ORDNr(""))))="" Quit $O(ORDNr(""))
 New DL,LD
 Set LD(2)="1;N+;L;8;;| \1;C;L;10;; | ;;$P(^KOD($P(^KO1(X,""F""),D),""F"",X,1),D,2)\1;C;L;25;; | ;;$P(^KKL(^KK1($P(^KO1(X,""F""),D)),0),D,2)\1;C;L;25;;;;$P(^KOD($P(^KO1(X,""F""),D),""F"",X,1),D,3)"
 Set LD(1)="ORDNr",LD(3)=20,LD(8)="Selekteer een order"
 Set DL(1)="LD"
 Do RL^PROC1
 Set LD(6)=1,R=""
 For  Set R=$O(ORDNr(R)) Quit:R=""  If $P(Rec,D,27)=ORDNr(R) Set LD(6)=R Quit
 Do WL^PROC
 For  Do SL^PROC Quit:"\-\ENTER\"[(D_R_D)
 Quit $S(R="-":R,1:ORDNr(@DL(1)@(6)))
 ;
 ; Ophalen van de ordergegevens van een Kom-toelevering
ORDGEG(LEVNr,TOENr,TLNr) 
 New R,KLNr,ORDNr,OrdDat,OrdRef
 Set LEVNr=$G(LEVNr,$P($G(^KTO1(TOENr)),D)),OrdGeg=""
 Do:LEVNr
 . If $G(TLNr) Set R=^KTO(LEVNr,TOENr,TLNr),ORDNr=$P(R,D,27)
 . Else  Set R=^KTO(LEVNr,TOENr,1),ORDNr=$P(R,D,7)
 . Quit:'ORDNr
 . Set KLNr=$P(^KO1(ORDNr,"F"),D)
 . Quit:'KLNr
 . Set R=^KOD(KLNr,"F",ORDNr,1),OrdDat=$P(R,D,2),OrdRef=$P(R,D,3)
 . Set OrdGeg=ORDNr_D_OrdDat_D_OrdRef
 Quit OrdGeg
 ;
 ; Geeft de gebruiker en tijdstip creatie het Kom-order
OrderCreatedBy(TOENr)
 New R,LEVNr,ORDNr
 Set LEVNr=$P($G(^KTO1(TOENr)),D),CreatedBy=""
 Do:LEVNr
 . Set R=^KTO(LEVNr,TOENr,1),ORDNr=$P(R,D,7)
 . Set:ORDNr CreatedBy=$$OrderCreatedBy^FLOWORD(ORDNr)
 Quit CreatedBy
 ;
 ; Splits toelevering volgens leveranciersklantnummer
TSPLIT(TLNr,NoComm) 
 Do TSPLIT^FLOWTOE3(TLNr,$G(NoComm))
 Quit
 ;
 ; Overbrengen van een lijn naar een andere toelevering
TMOVE   
 Quit:'$D(Detail)
 Set MoveTLNr=$$TMOVE^FLOWTOE3(LEVNr,TLNr,$G(MoveTLNr),Detail(@DL(1)@(6)))
 Quit
 ;
HOOFDING(Rubriek) 
 New R
 Set Rubriek=$G(Rubriek)
 If $$CHECKWMS^FLOW(TLNr,,,,,,1) Quit
 Set R="^KTO13"
 Set:Rubriek R="RUBRIEK"_R_"(Rubriek)"
 Do @R
 Quit
 ;
GWNODE(LEVNr,TLNr,TLLNr) 
 Quit $$GWNODE^FLOWTOE2(LEVNr,TLNr,TLLNr)
 ;
KWNODE(LEVNr,TLNr,TLLNr) 
 Do KWNODE^FLOWTOE2(LEVNr,TLNr,TLLNr)
 Quit
 ;
SWNODE(LEVNr,TLNr,TLLNr) 
 Do SWNODE^FLOWTOE2(LEVNr,TLNr,TLLNr)
 Quit
 ;
MODBEST(LEVNr,TOENr,TLNr,Negatief) 
 Do MODBEST^FLOWTOE2(LEVNr,TOENr,TLNr,$G(Negatief))
 Quit
 ;
 ; Herreken een lijn
LRECALC(LEVNr,TLNr,TLLNr,Display,TRecalc) 
 Do LRECALC^FLOWTOE2(LEVNr,TLNr,TLLNr,$G(Display),$G(TRecalc))
 Quit
 ;
 ; Herrekenen lijn via menu
MLRECALC(LEVNr,TLNr,TLLNr,Display) 
 New Rec,PRNr,TempRec
 Set (Rec,TempRec)=^KTO(LEVNr,TLNr,TLLNr),PRNr=$P(Rec,D,2)
 Quit:'PRNr
 If $P(Rec,D,26)'="*",$P(Rec,D,26)'="=" Kill TempRec
 Else  Quit:'$$TXTPOP^FLOW("LRECALC")  Set $P(Rec,D,26)="",^KTO(LEVNr,TLNr,TLLNr)=Rec
 Do LRECALC^FLOWTOE2(LEVNr,TLNr,TLLNr,$G(Display)) 
 If $D(TempRec) Do
 .Set Rec=^KTO(LEVNr,TLNr,TLLNr)
 .Quit:$L($P(Rec,D,26))  Quit:$P(Rec,D,26)=$P(TempRec,D,26)
 .Set $P(Rec,D,26)=$P(TempRec,D,26),^KTO(LEVNr,TLNr,TLLNr)=Rec
 .Do:Display EL^PROC
 Quit
 ;
 ; Herreken een toelevering
RECALC(TLNr,Display) 
 Do RECALC^FLOWTOE2(TLNr,$G(Display))
 Quit
 ;
REFRESH 
 If sRT=1 Write @F11,@F1 Xecute ^KTO(0,0)
 If sRT<$P(UD,D) Xecute ^KTO(0,"TT") Do ^KTO12
 If sRT<($P(UD,D,2)+1) Do WL^PROC
 DO RESET^vhScherm
 Quit
 ;
 ; Call back voor lijsdefinitie
CB(K,TLLNr) 
 New R
 Set R=^KTO(LEVNr,TLNr,TLLNr)
 If $P(R,D,17)="KTO11" Quit 3
 If $P(R,D,17)="" Quit 2
 If $P(R,D,2)'?.N Quit 1
 Quit ""
 ;
 ; Ophalen detail
FETCHDET 
 New TLLNr,Count
 Kill PrCount,Detail,@DL(1)@(7),@DL(1)@(9)
 Set TLLNr=100,(Count,PrCount)=0
 For  Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr=""  Do
 .Set Count=Count+1,Detail(Count)=TLLNr If $P(^KTO(LEVNr,TLNr,TLLNr),D,2) Set PrCount=PrCount+1
 .Set:UL'>$P(UD,D,2) UL=UL+1
 Do PRCOUNT^FLOW(PrCount,"KTO")
 Quit
 
 ; VHKLNr is optioneel, indien afwezig dan worden alle DIRORD toegelaten
ISDIRORD(TLNr,VHKLNr) 
 New R,LEVNr,IsDirOrd,LevKLNr
 Set IsDirOrd=0,R=$G(^KTO1(TLNr)),LEVNr=$P(R,D)
 If LEVNr=5005 Do
 .Set R=^KTO(5005,TLNr,1),LevKLNr=$P(R,D,9)
 .If LevKLNr,$D(^BLBeri("K",LevKLNr)) Set IsDirOrd=$P(^BLBeri("K",LevKLNr),D,6)="DO"
 .If IsDirOrd,$G(VHKLNr),$P(^BLBeri("K",LevKLNr),D,3)'=VHKLNr Set IsDirOrd=0
 Quit IsDirOrd
 ;
 ; Blum-klant ophalen
BLKlant(BLKLNr,VHKlant)
 New R,BLKlant,VHKLNr
 Set R=^BLBeri("K",BLKLNr),BLKlant=$P(R,D),VHKLNr=$P(R,D,3),SoDo=$P(R,D,6)
 If $G(VHKlant),VHKLNr Set BLKlant=$P(^KKL(^KK1(VHKLNr),0),D,2)
 Else  Do
 . Set:BLKlant["Van Hoecke - " BLKlant=$P(BLKlant,"Van Hoecke - ",2)
 . Set:BLKlant["Van Hoecke " BLKlant=$P(BLKlant,"Van Hoecke ",2)
 . Set:BLKlant[" Keukenfabriek" BLKlant=$P(BLKlant," Keukenfabriek")
 Set:SoDo="DO" BLKlant=BLKlant_" (DO)"
 Quit BLKlant
 ;
VALUE(TLNr,Type) 
 New R,LEVNr,TLLNr,Bruto,Netto,Value,Munt
 Set Type=$G(Type) Set:Type="" Type="BN"
 Set (Netto,Bruto)=0,Munt="",LEVNr=$P($G(^KTO1(TLNr)),D)
 If LEVNr Do
 .Set R=^KTO(LEVNr,TLNr,1),Munt=$P(R,D,18)
 .Set TLLNr=100
 .For  Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr=""  Do
 ..Set R=^KTO(LEVNr,TLNr,TLLNr),Bruto=Bruto+$P(R,D,16),Netto=Netto+$P(R,D,9)
 Set Value="" Set:Type["B" Value=Value_Bruto
 If Type["N" Set:$L(Value) Value=Value_D Set Value=Value_Netto
 Set:$L(Value) Value=Value_D_Munt
 Quit Value
 ;
DISPVAL(TLNr,Type) 
 New R,Value,Munt,Text
 Set Type=$G(Type) Set:Type="" Type="BN"
 Set Value=$$VALUE(TLNr,Type),Munt=$P(Value,D,$L(Value,D))
 Set (Bruto,Netto)="" Set:Type["B" Bruto=$P(Value,D)
 Set:Type["N" Netto=$P(Value,D,$S(Type["B":2,1:1))
 Set Text="" Set:Type["B" Text="Bruto : "_$P($$EXTNUM^vhDTyp(Bruto,0,".",$L($P(Bruto,".",2))),D)
 If Type["N" Set:$L(Text) Text=Text_" - " Set Text=Text_"Netto : "_$P($$EXTNUM^vhDTyp(Netto,0,".",$L($P(Netto,".",2))),D)
 Set R=$$^vhTXTPOP("FLOWTOE","DISPVAL","",$$EXTNUM^vhDTyp(TLNr,0,".",0),Text,Munt,"")
 Quit
 ;
 ; Afdukken van de toelevering
PRINT 
 Set FP=USM*100+1 W @F,@F1
 Do SORT(),FETCHDET,WL^PROC
 Do EXTERN^DCPRINT("T",TLNr,"","",1)
 Kill ^KOB(TLNr)
 Quit
 ;
 ; Afdrukken van de voorraadidentificatie
PrintVI
 New PRNr,PalletAantal,AantalPaginas
 Set PRNr=$P(^KTO(LEVNr,TLNr,Detail(@DL(1)@(6))),D,2)
 Set Aantal=$P(^KTO(LEVNr,TLNr,Detail(@DL(1)@(6))),D,3)
 Set PrintVI="T"
 If PRNr,$$IsHout^PRODUKT2(PRNr) Set PrintVI=$$^vhTXTPOP("FLOWTOE","VOORRAADIDENTIFICATIE","",TLNr,$P(^KPR(PRNr,0),D))
 Do:PrintVI="T" ##Class(CHUI.Prod.VoorraadIdentificatieDoc).PrintToeleveringVoorraadPaginas(TLNr)
 Do:PrintVI="P"
 . Set PalletAantal=##Class(BL.Prod.sub.pxVoorraadIdentificatieDocs).GeefToeleveringEenheid(PRNr)
 . Set AantalPaginas=(Aantal\PalletAantal)+(Aantal#PalletAantal>0)
 . Do ##Class(CHUI.Prod.VoorraadIdentificatieDoc).PrintProductVoorraadPagina(PRNr,PalletAantal,AantalPaginas,TLNr)
 Quit
 ;
INIT 
 Do INIT^FLOWTOE2
 Quit
 ;
MENU 
 Do CALL^vhMenu("FLOWTOE")
 Quit
 ;
SPEC 
 Do CALLSPEC^vhMenu(AD(3)+AD(6)-1_";80","FLOWTOEQCK","")
 Quit
 ;
UNIEKLNR(LEVNr,TOENr) 
 New TLUNr
 Set LEVNr=$G(LEVNr),TOENr=$G(TOENr)
 Set:'LEVNr LEVNr=$P(^KTO1(TOENr),D)
 Set TLUNr=$G(^KTO(LEVNr,TOENr,4)) Set:'TLUNr TLUNr=1
 Set ^KTO(LEVNr,TOENr,4)=TLUNr+1
 Quit TLUNr*100
 ;
 ; Geef het unieke lijnnummer van een toeleveringlijn
GeefToeleveringLijnCode(LeverancierID,ToeleveringID,ToeleveringLijnID)
 New Rec,ToeleveringLijnCode
 Set Rec=^KTO(LeverancierID,ToeleveringID,ToeleveringLijnID),ToeleveringLijnCode=$P(Rec,D,15)
 If 'ToeleveringLijnCode Set ToeleveringLijnCode=$$UNIEKLNR(LeverancierID,ToeleveringID),$P(Rec,D,15)=ToeleveringLijnCode,^KTO(LeverancierID,ToeleveringID,ToeleveringLijnID)=Rec
 Quit ToeleveringLijnCode
 ;
 ; Markeer de toeleveringlijn als urgent
MarkUrgent(TOENr,TLUNr)
 New LEVNr,TLNr,RCPNr
 Set LEVNr=$P($G(^KTO1(TOENr)),D),TLNr=$G(^TO("IU",TOENr,TLUNr))
 If LEVNr,TLNr Do
 . Set $P(^KTO(LEVNr,TOENr,TLNr),D,31)=1
 . Set RCPNr=$G(^RCP("IT",TOENr,TLUNr))
 . Quit:'RCPNr
 . For  Quit:$$LOCK^EWRCPST(RCPNr)
 . Set $P(^RCP("D",RCPNr,"D",TOENr,TLUNr),D,7)="U"
 . Do ZENDURG^EWRCPST(RCPNr,TOENr,TLUNr)
 . Do UNLOCK^EWRCPST(RCPNr)
 Quit
 ;
 ; Markeer de toeleveringlijn als niet urgent
UnMarkUrgent(TOENr,TLUNr)
 New LEVNr,TLNr,RCPNr
 Set LEVNr=$P($G(^KTO1(TOENr)),D),TLNr=$G(^TO("IU",TOENr,TLUNr))
 If LEVNr,TLNr Do
 . Set $P(^KTO(LEVNr,TOENr,TLNr),D,31)=""
 . Set RCPNr=$G(^RCP("IT",TOENr,TLUNr))
 . Quit:'RCPNr
 . For  Quit:$$LOCK^EWRCPST(RCPNr)
 . Set $P(^RCP("D",RCPNr,"D",TOENr,TLUNr),D,7)=""
 . Do ZENDURG^EWRCPST(RCPNr,TOENr,TLUNr)
 . Do UNLOCK^EWRCPST(RCPNr)
 Quit
 ;
 ; Is de toeleveringlijn urgent?
IsUrgent(TOENr,TLUNr)
 New UrgentCode,LEVNr,TLNr
 Set LEVNr=$P($G(^KTO1(TOENr)),D),TLNr=$G(^TO("IU",TOENr,TLUNr))
 If LEVNr,TLNr Set UrgentCode=$P(^KTO(LEVNr,TOENr,TLNr),D,31)
 Quit $G(UrgentCode,"?")
 ;
EWMS(Prog) 
 New EwmsLink
 Set EwmsLink=0
 If Prog="M" Do
 .Do VERWERK^EWRCPS(LEVNr,TLNr)
 .Do FETCHDET,ADD^vhScherm(1,24),REFRESH
 If Prog="S" Do
 .Do STORE^vhTERMINA()
 .Do TOELEV^EWRCPST(TLNr)
 .Do REFRESH^vhTERMINA()
 .If '$D(^KTO(LEVNr,TLNr)) Set Input="-"
 .Else  Do FETCHDET,ADD^vhScherm(1,24),REFRESH
 Quit
 ;
%EWMS(TOENr) 
 New R,%wms,TotLines,WmsLines,LEVNr,TLUNr,TLNr,PRNr,FysStock,Aantal
 Set TLUNr="",(TotLines,WmsLines)=0,LEVNr=$P(^KTO1(TOENr),D)
 For  Set TLUNr=$O(^TO("IU",TOENr,TLUNr)) Quit:TLUNr=""  Do
 .Set TLNr=^TO("IU",TOENr,TLUNr),R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3)
 .Quit:'PRNr
 .Set TotLines=TotLines+1 Set:$D(^RCP("IT",TOENr,TLUNr)) WmsLines=WmsLines+1
 Set %wms=$S(TotLines:WmsLines/TotLines*100,1:0)
 Quit %wms
 ;