#include BL.Derde.LevSpecifiek
 
FLOWTOER ;Inboeken toelevering [ 10/03/2003  11:21 AM ]
 ; LEVNr 6092 Folitec
 ;       6428 Niegel
 ;       6267 Polylak
 ;
VERWERK 
 New R,TOENr,LEVNr,Input,Detail,AD,Lines,Selected
 New IsLakW,ORDNr,KLNr,RecLoc
 Do INIT Quit:'LEVNr
 For  Do REFRESH,COMMAND Quit:Input="CANC"  If Input="SAVE" Do  Quit:$L(Input)
 .Set Input=$$^vhTXTPOP("FILE",$S($D(Receive):"SAVE",1:"EXIT"))
 .If Input="J",$D(Receive) Do
 ..Set LEVNr=$P($G(^KTO1(TOENr)),D) Quit:'LEVNr
 ..Kill RecLoc
 ..Merge RecLoc(TOENr)=Receive
 ..Do QCSTAT^EWRCPS(.RecLoc)
 ..Set R=^KTO(LEVNr,TOENr,1),ORDNr=$P(R,D,7),KLNr=$P(R,D,8)
 ..Do RCVTOE(TOENr,RecDate,.Receive)
 ..If KLNr,ORDNr Do
 ...If LEVNr'=6092,LEVNr'=6428,LEVNr'=6267 Quit
 ...Set IsLakW=$$ISLAKW(KLNr,ORDNr)
 ...If IsLakW Do
 ....If LEVNr=6092,$$ISGELAKT^FOLTECL(ORDNr) Quit
 ....If LEVNr=6428,$$ISGELAKT^FOLTECL(ORDNr) Quit
 ....Do MAILLAKW(LEVNr,TOENr,KLNr,ORDNr,IsLakW)
 Quit
 ;
COMMAND Set Input=$$SCROLL^vhLIST(.AD)
 If Input="COM" Set Input="" Do CALL^vhMenu("FLOWTOER")
 If Input="SPEC" Set Input="" Do CALLSPEC^vhMenu(AD("POS")+AD("SELECT")_";80","FLOWTOERS","E")
 Quit:Input=""
 Do EXEC^vhMenu("FLOWTOER",.Input)
 Quit
 ;
TOENR(Input) 
 New %TC,T,L,R,KLNr,ORDNr,IsLakW
 If Input'="O" Set T=$O(^KTO(LEVNr,TOENr),$S(Input="(":-1,1:1))
 Else  Do
 .Set LEVNr=$G(LEVNr),TOENr=$G(TOENr) Set:LEVNr L("L")=LEVNr,L("N")=1 Set:TOENr T(TOENr)=""
 .Do STORE^vhTERMINA()
 .Xecute "Set T=$$SELECT^FLOW(""KTO"",""KTO1"",1"_$S(LEVNr:",.T,.L",1:"")_")"
 .Do REFRESH^vhTERMINA()
 Set:T=$G(TOENr) T="-"
 Quit:'T
 If $D(TOENr) Do
 .If $D(Receive) Do
 ..Set LEVNr=$P($G(^KTO1(TOENr)),D) Quit:'LEVNr
 ..Set R=^KTO(LEVNr,TOENr,1),ORDNr=$P(R,D,7),KLNr=$P(R,D,8)
 ..Do RCVTOE(TOENr,RecDate,.Receive)
 ..If KLNr,ORDNr Do
 ...If LEVNr'=6092,LEVNr'=6428,LEVNr'=6267 Quit
 ...Set IsLakW=$$ISLAKW(KLNr,ORDNr)
 ...If IsLakW Do
 ....If LEVNr=6092,$$ISGELAKT^FOLTECL(ORDNr) Quit
 ....If LEVNr=6428,$$ISGELAKT^FOLTECL(ORDNr) Quit
 ....Do MAILLAKW(LEVNr,TOENr,KLNr,ORDNr,IsLakW)
 .Do REMOVE^vhLock("^KTO(LEVNr,TOENr)")
 Set TOENr=T
 For  Do ADD^vhLock("^KTO(LEVNr,TOENr)") Quit:%TC  Do LDISP^vhLock("^KTO(LEVNr,TOENr)","Toelevering "_TOENr)
 Set:'LEVNr LEVNr=$P(^KTO1(TOENr),D)
 Set R=^KTO(LEVNr,TOENr,1),Refer=$P(R,D,3),ABNr=$P(R,D,10)
 Do INIT^vhLIST("FLOWTOER","LIST",.AD),FETCHDET,ADD^vhScherm(1,24)
 Kill Receive
 Quit
 ;
AANTAL(Input,Select) 
 New R,FromLine,ToLine,Line,UniekLNr,TLLNr,PRNr,Aantal,Quit
 Set Input=$G(Input),Select=$G(Select)
 If 'Select Set FromLine=$O(Detail("")),ToLine=$O(Detail(9999),-1)
 Else  Set (FromLine,ToLine)=Select
 Set Line=$O(Detail(FromLine),-1)
 For  Set Line=$O(Detail(Line)) Do  Quit:Line=ToLine
 .Set TLLNr=Detail(Line),R=^KTO(LEVNr,TOENr,TLLNr)
 .Set PRNr=$P(R,D,2),Aantal=$P(R,D,3),UniekLNr=$P(R,D,15)
 .If 'UniekLNr Do
 ..Do BUILDTO^FLOWTOE3(LEVNr,TOENr,TLLNr)
 ..Set R=^KTO(LEVNr,TOENr,TLLNr),UniekLNr=$P(R,D,15)
 .If $D(^RCP("IT",TOENr,UniekLNr)) Write:Select *7 Quit
 .If 'PRNr,'Select Quit
 .If Input'="W",Input'="B",'$D(Receive(UniekLNr)),'$$OPSLMAN^PRODUKT2(PRNr) Do  Quit:'Quit
 ..Set Quit=$$^vhTXTPOP("FLOWTOER","NOMANPROD","",$P(^KPR(PRNr,0),D))="V"
 ..Quit:'Quit
 ..Set Quit=1 ;$$ASK^vhWACHTW("MANAGER")
 .If Input'="W",'$D(Receive(UniekLNr)) Set Receive(UniekLNr)="",Selected=Selected+1
 .If Input="W" Quit:'$D(Receive(UniekLNr))  Kill Receive(UniekLNr)
 .Else  If "V"'[Input Do
 ..Do STORE^vhTERMINA(),DISPLAY^vhScherm("FLOWTOERA")
 ..If Input'="B" Do FIELD^vhScherm("FLOWTOERA",4)
 ..If Input="B" Do FIELD^vhScherm("FLOWTOERA",5)
 ..Do RESET^vhScherm,REFRESH^vhTERMINA()
 .Else  If PRNr Set Receive(UniekLNr)=$P(R,D,3)
 .If $TR($G(Receive(UniekLNr)),"\0","")="" Kill Receive(UniekLNr) Set Selected=Selected-1
 .If Select Do
 ..If Input'="V",Input'="ENTER" Do LINE^vhLIST(.AD,AD("SELECT")) Quit
 ..Do MOVE^vhLIST(.AD,"DO",1)
 If 'Select Do WRITE^vhLIST(.AD)
 Do DISPLAY^vhScherm("FLOWTOER","","","",6)
 Quit
 ;
DETAIL(Select) 
 New R,UniekLNr,TLLNr,PRNr,Aantal
 Set TLLNr=Detail(Select)
 Set R=^KTO(LEVNr,TOENr,TLLNr),PRNr=$P(R,D,2),Aantal=$P(R,D,3),UniekLNr=$P(R,D,15)
 If 'UniekLNr Do
 .Do BUILDTO^FLOWTOE3(LEVNr,TOENr,TLLNr)
 .Set R=^KTO(LEVNr,TOENr,TLLNr),UniekLNr=$P(R,D,15)
 Do STORE^vhTERMINA(),DISPLAY^vhScherm("FLOWTOERD"),RESET^vhScherm,REFRESH^vhTERMINA()
 Quit
 ;
TOELEV 
 New Locals
 Set Locals("TOENr")=TOENr,Locals("Extern")=1
 Do DO^vhPROGRAM("FTE^KTO30"),INIT^vhLIST("FLOWTOER","LIST",.AD),FETCHDET,ADD^vhScherm(1,24)
 Quit
 ;
ORDER 
 New R,TLLNr,ORDNr,Locals
 Set TLLNr=Detail(AD("SELECT")),R=^KTO(LEVNr,TOENr,TLLNr),ORDNr=$P(R,D,27) Quit:'ORDNr
 Set Locals("ORDNr")=ORDNr,Locals("Extern")=1
 Do DO^vhPROGRAM("FOE^KF9"),INIT^vhLIST("FLOWTOER","LIST",.AD),FETCHDET,ADD^vhScherm(1,24)
 Quit
 ;
RPLPR 
 New R,PR
 Quit:'$D(Detail)
 Set R=^KTO(LEVNr,TOENr,Detail(AD("SELECT"))),PR=$P(R,D,2) Quit:'PR
 Goto RPLPR^FLOW
 ;
KILLKOML 
 New %TC,R,TLLNr,PRNr,KLNr,ORDNr,OLNr,Aantal,FysStock,ResStock,PraStock,Taal
 Set TLLNr=Detail(AD("SELECT")),R=^KTO(LEVNr,TOENr,TLLNr),PRNr=$P(R,D,2),ORDNr=$P(R,D,27),OLNr=$P($P(R,D,28),";")
 Quit:'PRNr!'ORDNr
 Quit:'$D(^KO1(ORDNr,"F"))
 Set KLNr=$P(^KO1(ORDNr,"F"),D),R=^KKL(^KK1(KLNr),0),Taal=$P(R,D,9) Set:Taal="" Taal="N"
 Set R=^KOD(KLNr,"F",ORDNr,OLNr),Aantal=$P(R,D,3)
 Set R=^KPR(PRNr,0),FysStock=$P(R,D,14),R=^KPR(PRNr,2),ResStock=$P(R,D,9),PraStock=FysStock-ResStock+Aantal
 If Aantal'>PraStock Set R=$$^vhTXTPOP("FLOWTOER","KILLKOML")
 If Aantal>PraStock Do
 .Set FysStock=$$EXTNUM^vhDTyp(FysStock,8,"T.",0)
 .Set PraStock=$$EXTNUM^vhDTyp(PraStock,8,"T.",0)
 .Set R=$$^vhTXTPOP("FLOWTOER","KOMSTOCK","",FysStock,PraStock,$$EXTNUM^vhDTyp(Aantal,8,"T.",0))
 Quit:R'="V"
 For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D))
 Do KWNODE^FLOWTOE(LEVNr,TOENr,TLLNr)
 Do InvoerUitvoerLinkVerbroken^FLOWTOE2(LEVNr,TOENr,TLLNr)
 Set Rec=^KTO(LEVNr,TOENr,TLLNr),$P(Rec,D,27,28)=D,^KTO(LEVNr,TOENr,TLLNr)=Rec
 Do SWNODE^FLOWTOE(LEVNr,TOENr,TLLNr)
 For  Do ADD^vhLock("^KOD(KLNr,""F"",ORDNr)") Quit:%TC  Do LDISP^vhLock("^KOD(KLNr,""F"",ORDNr)","Order "_ORDNr)
 Do KWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 Set Rec=^KOD(KLNr,"F",ORDNr,OLNr),$P(Rec,D,27,28)=D,^KOD(KLNr,"F",ORDNr,OLNr)=Rec
 Do SWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 Kill ^KTOK(LEVNr,TOENr,TLLNr)
 Do REMOVE^vhLock("^KOD(KLNr,""F"",ORDNr)")
 Do REMOVE^vhLock("^KPR(PRNr)")
 Do LINE^vhLIST(.AD,AD("SELECT"))
 Quit
 ;
REFRESH 
 If sRT<$P(AD("POS"),";") Do DISPLAY^vhScherm("FLOWTOER")
 If sRT<($P(AD("POS"),";")+$P(AD("POS"),";",3)) Do WRITE^vhLIST(.AD)
 DO RESET^vhScherm
 Quit
 ;
 ; Ophalen detail
FETCHDET 
 New R,TLLNr,Count,PRNr,UniekLNr
 Kill Detail
 Set TLLNr=100,(Count,Lines,Selected)=0
 For  Set TLLNr=$O(^KTO(LEVNr,TOENr,TLLNr)) Quit:TLLNr=""  Do
 .Set Count=Count+1,Detail(Count)=TLLNr,R=^KTO(LEVNr,TOENr,TLLNr),PRNr=$P(R,D,2),UniekLNr=$P(R,D,15)
 .If 'UniekLNr Do
 ..Do BUILDTO^FLOWTOE3(LEVNr,TOENr,TLLNr)
 ..Set R=^KTO(LEVNr,TOENr,TLLNr),UniekLNr=$P(R,D,15)
 .If PRNr Set Lines=Lines+1 If $D(Receive(UniekLNr)) Set Selected=Selected+1
 Quit
 ;
LINES() 
 Quit "("_Selected_"/"_Lines_")"
 ;
INIT 
 Do INIT^vhLIST("FLOWTOER","LIST",.AD)
 Set RecDate=+$H,(LEVNr,TOENr,ABNr,Refer)=""
 Do ADD^vhScherm(1,24),REFRESH
 Do RECDATE Quit:'%SC
 Set LEVNr=$$SELECT^LEVER(1) Quit:'LEVNr
 Do ADD^vhScherm(1,24),REFRESH
 Do TOENR("O")
 Set:'TOENr LEVNr=""
 Quit
 ;
RECDATE 
 Do FIELD^vhScherm("FLOWTOER",1)
 Quit:'%SC
 Do DISPLAY^vhScherm("FLOWTOER","","","",1) ;,RESET^vhScherm
 Quit
 ;
RCVTOE(TOENr,RecDate,Receive) 
 New R,LEVNr,TLLNr,PRNr,TLUNr,BackOrd
 Set LEVNr=$P($G(^KTO1(TOENr)),D) Quit:'LEVNr
 Set TLUNr=""
 For  Set TLUNr=$O(Receive(TLUNr)) Quit:TLUNr=""  Do
 .Set TLLNr=^TO("IU",TOENr,TLUNr)
 .Set R=Receive(TLUNr),Receive=$P(R,D),BackOrd=$P(R,D,2)
 .Do RCVLINE(TOENr,TLLNr,Receive,BackOrd)
 Do CHKDEL^FLOWTOE(TOENr)
 Quit
 ;
RCVLINE(TOENr,TLLNr,Receive,BackOrd) 
 New %TC,R,Rec,LEVNr,PRNr,ABLNr,Besteld,KLNr,ORDNr,OLNr,OLUNr,RDate,PR,CifPPL,ASAP
 New LijstPr,LevTA,LevTB,LevTW,IDNr,Decimals,IsEuro,TLUNr,IsWerkVl,DefMag,RTemp,OldAantal
 Do COPY^EWTOE(TOENr)
 Set LEVNr=$P($G(^KTO1(TOENr)),D) Quit:'LEVNr
 Set Rec=^KTO(LEVNr,TOENr,TLLNr),(PRNr,PR)=$P(Rec,D,2) Quit:'PRNr
 Set IsEuro=$$ISEURO^vhRtn1()
 Set IsWerkVl="\0\9\"[(D_$$OPSLZONE^PRODUKT2(PRNr)_D),R=$G(^KPR(PRNr,15)),DefMag=$P(R,D,11)
 For  Do ADD^vhLock("^KPR(PRNr)") Quit:%TC  Do LDISP^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D))
 Set IDNr=$P(^KPR(PRNr,2),D,25)
 Set Besteld=$P(Rec,D,3),TLUNr=$P(Rec,D,15),ORDNr=$P(Rec,D,27),OLNr=$P($P(Rec,D,28),";")
 Set LevTB=$P(Rec,D,25),LevTA=$P(Rec,D,29) S:'$L(LevTA) LevTA=LevTB
 Set LevTW=$TR($$EXTDATE^vhDTyp(RecDate,"DW4"),"/","")
 Set RDate=$TR($$EXTDATE^vhDTyp(RecDate,"DS"),D,"")
 Set R=^KPR(PRNr,"J"_LEVNr),CifPPL=$P(R,D,23),LijstPr=$P(R,D,25)
 If IsWerkVl,DefMag="W" Do
 .New OrdDat
 .If ORDNr Set OrdDat=$P($$ORDGEG^FLOWTOE(LEVNr,TOENr,TLLNr),D,2) Set:$L(OrdDat) OrdDat=$$INTDATE^vhDTyp(OrdDat)
 .Set R=RDate_1_D_Receive_D_D_1_D_(CifPPL*Receive)_D_D_D_TOENr_D_D_D_DT_D
 .Set RTemp=R
 .Set:$P(RTemp,D,2) R=$$CV2EENH^MRP(PRNr,$P(RTemp,D,2)),$P(RTemp,D,5)=$P(RTemp,D,5)/$P(RTemp,D,2)*R,$P(RTemp,D,2)=R
 .Set R=RTemp,$P(R,D,13)=1
 .Do WV^KPR10,PUT^PRHIST(PRNr,Receive,"I","W",LEVNr,TOENr,TLUNr,RecDate,,,,,,$G(OrdDat))
 .Do:$$HasHalfFabr^PRBS(PRNr) HADPR^PRHF(TOENr,TLUNr,PRNr,Receive,RecDate) ; Verwerking halffabrikaten
 Else  If $E(IDNr)'=7 Do  ; Geen DO-product
 .New OrdDat
 .If ORDNr Set OrdDat=$P($$ORDGEG^FLOWTOE(LEVNr,TOENr,TLLNr),D,2) Set:$L(OrdDat) OrdDat=$$INTDATE^vhDTyp(OrdDat)
 .Set R=RDate_1_D_Receive_D_$J(CifPPL,0,$S(IsEuro:4,1:2))_D_1_D_$J(LijstPr,0,$S(IsEuro:4,1:2))_D_D_0_D_TOENr_D
 .Do ^KPR20
 .Do PUT^PRHIST(PRNr,Receive,"I",,LEVNr,TOENr,TLUNr,RecDate,,,,,,$G(OrdDat))
 .Do:$$HasHalfFabr^PRBS(PRNr) HADPR^PRHF(TOENr,TLUNr,PRNr,Receive,RecDate) ; Verwerking halffabrikaten
 Else  Do  ; DO-product
 .Set RDate=$$INTDATE^vhDTyp($E(RDate,1,4)_D_$E(RDate,5,6)_D_$E(RDate,7,8),"DS")
 .Do ONE^BLHIST(PRNr,RDate,Receive,(CifPPL*Receive),("T;"_TOENr))
 .Do ##class(BL.Flow.RecuPak.Main).ToelevDO(LEVNr,PRNr,Receive,TOENr,TLUNr)
 Do KWNODE^FLOWTOE(LEVNr,TOENr,TLLNr)
 Do ProductToeleveringLijnIngeboekt^EWRCPS2(LEVNr,TOENr,TLLNr)
 For  Do ADD^vhLock("^KSPW(PRNr)") Quit:%TC  Hang 1
 Set Decimals=$$MUNT^vhRtn1(,4),R=TOENr
 For  Quit:'$D(^KSPW(PRNr,LevTW,R))  Set R=R+.1
 Set ^KSPW(PRNr,LevTW,R)=Receive_D_$J(CifPPL*Receive,0,Decimals)_D_LevTB_D_LevTA_D_$E(LevTW,3,4)_"/"_$E(LevTW,5,6)_D_''ORDNr_D
 Do REMOVE^vhLock("^KSPW(PRNr)"),COPY^EWTOE(TOENr,TLLNr,Rec,Receive)
 Do:$E(IDNr)'=7 ##class(Flow.Toelevering).RecuPak(PRNr,Receive,TOENr,TLUNr)
 If ORDNr Do
 .Quit:'$D(^KO1(ORDNr,"F"))
 .Set KLNr=$P(^KO1(ORDNr,"F"),D)
 .For  Do ADD^vhLock("^KOD(KLNr,""F"",ORDNr)") Quit:%TC  Do LDISP^vhLock("^KOD(KLNr,""F"",ORDNr)","Order "_ORDNr)
 .Do KWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 .Set Rec=^KOD(KLNr,"F",ORDNr,OLNr),OldAantal=$P(Rec,D,3)
 .Quit:'OldAantal
 .Set ASAP=$P(^KOD(KLNr,"F",ORDNr,1),D,28)
 .Set $P(Rec,D,9)=$J(($P(Rec,D,9)/$P(Rec,D,3)*Receive),0,2)
 .Set $P(Rec,D,10)=$J(($P(Rec,D,10)/$P(Rec,D,3)*Receive),0,2)
 .Set $P(Rec,D,16)=$J(($P(Rec,D,16)/$P(Rec,D,3)*Receive),0,2)
 .Set $P(Rec,D,3)=Receive,$P(Rec,D,27,28)="\KOM"
 .Set ^KOD(KLNr,"F",ORDNr,OLNr)=Rec
 .Do SWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 .Do:Receive'=OldAantal ProductOrderLijnGewijzigd^FLOWORD2(KLNr,ORDNr,OLNr,##class(DOM.VKP.enu.ProductOrderLijnWijzigingType).Aantal())
 .Do:ASAP ASAP^EWTOE(ORDNr)
 .Set OLUNr=$P(Rec,D,15)
 .If LEVNr=$$$LevHalux Do:OLUNr MergeOLUNrs^FLOWORD6(ORDNr,OLUNr)
 If 'BackOrd Do KILL(TOENr,TLLNr)
 If BackOrd Do
 .Set Rec=^KTO(LEVNr,TOENr,TLLNr) Set:'$P(Rec,D,23) $P(Rec,D,23)=$P(Rec,D,3)
 .Set $P(Rec,D,9)=$J(($P(Rec,D,9)/$P(Rec,D,3)*BackOrd),0,2)
 .Set $P(Rec,D,10)=$J(($P(Rec,D,10)/$P(Rec,D,3)*BackOrd),0,2)
 .Set $P(Rec,D,16)=$J(($P(Rec,D,16)/$P(Rec,D,3)*BackOrd),0,2)
 .Set $P(Rec,D,3)=BackOrd,$P(Rec,D,15)=$P(Rec,D,15)+1
 .Set ^KTO(LEVNr,TOENr,TLLNr)=Rec
 .Do SWNODE^FLOWTOE(LEVNr,TOENr,TLLNr)
 .Do ProductToeleveringLijnGemaakt^FLOWTOE2(LEVNr,TOENr,TLLNr)
 .If ORDNr Do
 ..Quit:'$D(^KO1(ORDNr,"F"))
 ..For  Do ADD^vhLock("^KOD(KLNr,""F"",ORDNr)") Quit:%TC  Do LDISP^vhLock("^KOD(KLNr,""F"",ORDNr)","Order "_ORDNr)
 ..Set Rec=^KOD(KLNr,"F",ORDNr,OLNr)
 ..Quit:'$P(Rec,D,3)
 ..Set OLNr=^KOD(KLNr,"F",ORDNr,0),^KOD(KLNr,"F",ORDNr,0)=OLNr+1
 ..Set $P(Rec,D,9)=$J(($P(Rec,D,9)/$P(Rec,D,3)*BackOrd),0,2)
 ..Set $P(Rec,D,10)=$J(($P(Rec,D,10)/$P(Rec,D,3)*BackOrd),0,2)
 ..Set $P(Rec,D,16)=$J(($P(Rec,D,16)/$P(Rec,D,3)*BackOrd),0,2)
 ..Set $P(Rec,D,3)=BackOrd,$P(Rec,D,15)="",$P(Rec,D,27,28)=TOENr_D_TLLNr
 ..Set ^KOD(KLNr,"F",ORDNr,OLNr)=Rec
 ..Do SWNODE^FLOWORD(KLNr,ORDNr,OLNr)
 ..Do ProductOrderLijnGemaakt^FLOWORD2(KLNr,ORDNr,OLNr)
 ..If $D(^KTOK(LEVNr,TOENr,TLLNr)) Set $P(^KTOK(LEVNr,TOENr,TLLNr),D,5)=OLNr
 ..Set Rec=^KTO(LEVNr,TOENr,TLLNr)
 ..New r Set r=$P(Rec,D,28),$P(r,";")=OLNr,$P(Rec,D,28)=r
 ..Set ^KTO(LEVNr,TOENr,TLLNr)=Rec
 If ORDNr Do REMOVE^vhLock("^KOD(KLNr,""F"",ORDNr)")
 Do REMOVE^vhLock("^KPR(PRNr)")
 Quit
 ;
ISLAKW(KLNr,ORDNr) 
 New R,OLNr,PRNr,IsLakW,LakRal,TOENr
 Set IsLakW=0,OLNr=100
 For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2),LakRal=$P(R,D,4),TOENr=$P(R,D,27)
 .Quit:'PRNr  Quit:LakRal=""
 .If '$D(^KPR(PRNr,"J6092")),'$D(^KPR(PRNr,"J6428")) Quit  ; Folietec of Niegel
 .If 'TOENr Set:'IsLakW IsLakW=2
 .Else  Set:IsLakW IsLakW=1
 Quit IsLakW
 ;
POLNR(KLNr,ORDNr) 
 New R,OLNr,PRNr,POLNr
 Set POLNr=0,OLNr=100
 For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:OLNr=""  Do  Quit:POLNr
 .Set R=^KOD(KLNr,"F",ORDNr,OLNr),PRNr=$P(R,D,2)
 .Quit:'PRNr  Quit:'$D(^KPR(PRNr,"J6267"))  ; Polylak
 .Set POLNr=$P(R,D,27)
 Quit POLNr
 ;
MAILLAKW(LEVNr,TOENr,KLNr,ORDNr,LakStat) 
 New R,KLNaam,MailId,Text,Ref,POLNr,Users
 Set LakStat=$G(LakStat)
 If LEVNr=6092!(LEVNr=6428) Do
 .Set POLNr=$$POLNR(KLNr,ORDNr)
 .If POLNr Do
 ..Set R=^KKL(^KK1(KLNr),0),KLNaam=$P(R,D,2)
 ..Set Text="Order "_$$EXTNUM^vhDTyp(ORDNr,0,".",0)_" van klant "_KLNaam
 ..Set Text=Text_" is"_$S(LakStat=1:" gedeeltelijk",1:"")
 ..Set Text=Text_" klaar om gelakt te worden. Gelieve kontakt op te nemen met POLYLAK aub."
 ..Set Ref(1)="LE\6267\R\",Ref(2)="TL\"_POLNr_"\R\"
 ..Set Ref(3)="KL\"_KLNr_"\R\O",Ref(4)="ORD\"_ORDNr_"\R\"
 ..Set MailId=$$SYSTEM^vhMAIL("LE",6267,"Toelevering "_$$EXTNUM^vhDTyp(POLNr,0,".",0),"FOLTEC",.Text,.Ref,1,1)
 .If $G(MailId) Do
 ..Set Users=$$TUSERID^vhMAIL(MailId)
 ..Set Users=$$USERNAME^vhUSER(Users)
 ..If '$L(Users) Set R="Gelieve kontakt op te nemen met POLYLAK aub."
 ..Else  Do
 ...If $L(Users,";")>1 Do
 ....For  Quit:Users'[";"  Set Users=$P(Users,";")_$S($P(Users,";",2,99)[";":", ",1:" en ")_$P(Users,";",2,99)
 ....Set R=" zijn"
 ...Else  Set R=" is"
 ...Set R=Users_R_" verwittigd."
 .Set R=$$^vhTXTPOP("FLOWTOER","LAKWERK",,$$EXTNUM^vhDTyp(ORDNr,0,".",0),KLNaam,R)
 Else  If LEVNr=6267,'$D(^KTO(LEVNr,TOENr)) Do
 .Set R=^KKL(^KK1(KLNr),0),KLNaam=$P(R,D,2)
 .Set Text="Order "_$$EXTNUM^vhDTyp(ORDNr,0,".",0)_" van klant "_KLNaam
 .Set Text=Text_" is gelakt en kan dus uitgeleverd worden."
 .Set Ref(1)="KL\"_KLNr_"\R\O",Ref(2)="ORD\"_ORDNr_"\R\"
 .Set MailId=$$SYSTEM^vhMAIL("KL",KLNr,"Order "_$$EXTNUM^vhDTyp(ORDNr,0,".",0),"FOLTEC",.Text,.Ref,1,1)
 Quit
 ;
 ; Opkuis bestanden
KILL(TOENr,TLLNr) 
 New R,LEVNr,ABNr,ABLNr
 Set LEVNr=$P($G(^KTO1(TOENr)),D) Quit:'LEVNr
 Set R=^KTO(LEVNr,TOENr,TLLNr),ABLNr=$P(R,D,13,14)
 Kill ^KTOK(LEVNr,TOENr,TLLNr),^KTO3(TOENr,ABLNr_D_TLLNr),^KTO(LEVNr,TOENr,TLLNr)
 If $N(^KTO(LEVNr,TOENr,100))=-1 Do
 .Set R=^KTO(LEVNr,TOENr,1),ABNr=$P(R,D,10)
 .Do KILLAB^FLOWTOE3(LEVNr,TOENr,ABNr)
 .Kill ^KTO1(TOENr),^KTO2(LEVNr,TOENr),^KTOB(TOENr),^KTO(LEVNr,TOENr),^BLBeri("Z",TOENr)
 Quit
 ;