#Include BL.Derde.LevSpecifiek #Include Prod.Product FLOWTOE3 ;Toelevering [ 04/08/2003 1:19 PM ] ; ; Splits toelevering TSPLIT(TLNr,NoComm,NTLNr) New R,IK,HULP,LEVNr,KLNr,LEVKLNr,TLLNr,PRNr,ABNr,LCount,Comment,MaxLines,FTLNr,TTLNr,TLUNr,DefKLNr,DOKLNr,DOBLKLNr,TOENr,TOENrs Set TOENrs(TLNr)="" Set Comment='$G(NoComm),MaxLines=70 Set Comment='$G(NoComm),MaxLines=120 Quit:'$D(^KTO1(TLNr)) Set LEVNr=$P(^KTO1(TLNr),D) Set R=^KTO(LEVNr,TLNr,1),ABNr=$P(R,D,10) If LEVNr=6332,$$HALUXTYP^FLOWCHK("T",TLNr)="TBX" Set MaxLines=999 If LEVNr=6332,$$HALUXTYP^FLOWCHK("T",TLNr)="LBX" Set MaxLines=299 Quit:$E($P(R,D,3),1,9)="START WMS" Set (DOKLNr,DOBLKLNr)="" If $$IsDOToe(TLNr) Set DOBLKLNr=$P(^KTO(LEVNr,TLNr,1),D,9) Set:DOBLKLNr DOKLNr=$P(^BLBeri("K",DOBLKLNr),D,3) Set TLLNr=100,DefKLNr="" For Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr="" Do .Set R=^KTO(LEVNr,TLNr,TLLNr),PRNr=$P(R,D,2) Quit:'PRNr .If DOBLKLNr,DOKLNr Set KLNr=DOKLNr,LEVKLNr=DOBLKLNr .Else Set KLNr=$$KLSELECT(PRNr,DefKLNr),LEVKLNr=$P($G(^PRPUTZ("N",PRNr,KLNr,0)),D) .If 'LEVKLNr,LEVNr=5005 Set LEVKLNr=212250 .Set:LEVKLNr="" LEVKLNr=0 Set HULP(LEVKLNr,TLLNr)="" .Set DefKLNr=KLNr Set LEVKLNr=$O(HULP("")) ; Opzoeken van de LEVKLNr die in de oorspronkelijke toelevering blijft If $O(HULP(LEVKLNr))'="" Do .If LEVKLNr Do ..Set TLLNr=100 ..For Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr="" Do ...Set R=^KTO(LEVNr,TLNr,TLLNr),PRNr=$P(R,D,2) Quit:'PRNr ...Set KLNr="" ...For Set KLNr=$O(^PRPUTZ("N",PRNr,KLNr)) Quit:KLNr="" Do ....Set LEVKLNr=$P($G(^PRPUTZ("N",PRNr,KLNr,0)),D) ....If 'LEVKLNr,LEVNr=5005 Set LEVKLNr=212250 ....Set:LEVKLNr="" LEVKLNr=0 Set:$D(HULP(LEVKLNr)) KLNr="Z" ...Set TLLNr="Z" If LEVKLNr Set R=^KTO(LEVNr,TLNr,1),$P(R,D,9)=LEVKLNr,^KTO(LEVNr,TLNr,1)=R If $L(LEVKLNr) Kill HULP(LEVKLNr) If '$D(HULP) Do .Merge NTLNr=TLNr .Do MAXLINES(.NTLNr,MaxLines) .Kill NTLNr(TLNr) Else Do .Set LEVKLNr="" .For Set LEVKLNr=$O(HULP(LEVKLNr)) Quit:LEVKLNr="" Do ..Set NTLNr=$$GETNUM^FLOW("KTO","KTO1"),NTLNr(NTLNr)="",TOENrs(NTLNr)="" ..If LEVKLNr Set R=^KTO(LEVNr,TLNr,1),$P(R,D,9)=LEVKLNr,^KTO(LEVNr,NTLNr,1)=R ..Set (TLLNr,LCount)=100 ..Set ^KTO1(NTLNr)=LEVNr_D ..For Set TLLNr=$O(HULP(LEVKLNr,TLLNr)) Quit:TLLNr="" Do ...Set LCount=LCount+1 ...Do LMOVE(TLNr,TLLNr,NTLNr,LCount) ..Set ^KTO(LEVNr,NTLNr,0)=$$NEXTFREE(LEVNr,NTLNr),TLUNr=$$NEXTTLUNR(LEVNr,NTLNr)\100 ..Set:$G(^KTO(LEVNr,NTLNr,4)) per kleur + extra split KAD & TBX Set TOENr="" For Set TOENr=$O(TOENrs(TOENr)) Quit:TOENr="" Do SplitHaluxProd(TOENr,.NTLNr) If Comment,$O(NTLNr(""))&&'##class(TECH.Config.ConfigMgr).Instance().GeefBoolean("BevestigdAXOrderSluitenActief") Do COMMENT("NTLNr") Quit ; ; Bepalen van het volgende unieke Blum-lijnnummer NEXTFREE(LEVNr,TOENr) New R,TLNr,NextFree,UniekLNr Set (TLNr,NextFree)=100 For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do .Set R=^KTO(LEVNr,TOENr,TLNr),UniekLNr=$P(R,D,13) .Set:UniekLNr+100>NextFree NextFree=UniekLNr+100 Quit NextFree+1 ; ; Bepalen van het volgende interne unieke lijnnummer NEXTTLUNR(LEVNr,TOENr) New R,TLNr,NextFree,UniekLNr Set TLNr=100,NextFree=100 For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do .Set R=^KTO(LEVNr,TOENr,TLNr),UniekLNr=$P(R,D,15) .Set:UniekLNr>NextFree NextFree=UniekLNr Quit NextFree+100 ; ; Verplaats een lijn van de ene toelevering naar de andere LMOVE(FromToe,FromLijn,ToToe,ToLijn) New %TC,R,PRNr,ORDNr,OLNr,KLNr,UniekLNr Set R=^KTO(LEVNr,FromToe,FromLijn),PRNr=$P(R,D,2),ORDNr=$P(R,D,27),OLNr=$P($P(R,D,28),";") If PRNr Do .Do KWNODE^FLOWTOE(LEVNr,FromToe,FromLijn) .If ORDNr,OLNr Do InvoerUitvoerLinkVerbroken^FLOWTOE2(LEVNr,FromToe,FromLijn) .Do ProductToeleveringLijnAnnulatie^FLOWTOE2(LEVNr,FromToe,FromLijn) .Kill ^KTO3(FromToe,$P(R,D,13,14)_D_FromLijn) .If LEVNr'=5005 Do ..Set UniekLNr=$P(R,D,13) ..If $P($O(^KTO3(ToToe,ToLijn-100_D)),D)'=(ToLijn-100) Set UniekLNr=ToLijn-100 ..Else For UniekLNr=1:1 Quit:$P($O(^KTO3(ToToe,UniekLNr_D)),D)'=UniekLNr ..Set $P(R,D,13)=UniekLNr .Set ^KTO3(ToToe,$P(R,D,13,14)_D_ToLijn)="" Kill ^KTO(LEVNr,FromToe,FromLijn) Set ^KTO(LEVNr,ToToe,ToLijn)=R Quit:'PRNr Do SWNODE^FLOWTOE(LEVNr,ToToe,ToLijn) Do ProductToeleveringLijnGemaakt^FLOWTOE2(LEVNr,ToToe,ToLijn) If ORDNr,OLNr Do .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) .Set R=^KOD(KLNr,"F",ORDNr,OLNr),$P(R,D,27)=ToToe,$P(R,D,28)=ToLijn,^KOD(KLNr,"F",ORDNr,OLNr)=R .Do REMOVE^vhLock("^KOD(KLNr,""F"",ORDNr)") .Do InvoerUitvoerLinkAangemaakt^FLOWTOE2(LEVNr,ToToe,ToLijn) If $D(^KTOK(LEVNr,FromToe,FromLijn)) Do .Set R=^KTOK(LEVNr,FromToe,FromLijn),^KTOK(LEVNr,ToToe,ToLijn)=R .Kill ^KTOK(LEVNr,FromToe,FromLijn) Quit ; ; Optie ; B : Geef het Blum klantnummer KLSELECT(PRNr,DefKLNr,Optie) New KLNr,KlKey,zb Set KLNr="" For Set KLNr=$O(^PRPUTZ("N",PRNr,KLNr)) Quit:KLNr="" Do . Set KlKey=^KK1(KLNr),KlKey(KlKey)=KLNr_D_$P(^KKL(KlKey,0),D,2) Set KlKey=$O(KlKey("")) If KlKey="" Set KLNr=0 Else If $O(KlKey(KlKey))="" Set KLNr=$P(KlKey(KlKey),D) Else Do . Set KlKey="KlKey" . Do RENUMBER^vhLIST(.KlKey) . Set KLNr=$$WILD^vhPOPUP("C;C","-VOK1",$P(^KPR(PRNr,0),D)_" - Direct order voor",.KlKey,DefKLNr) If KLNr,$G(Optie)["B" Set KLNr=$P(^PRPUTZ("N",PRNr,KLNr,0),D) Quit KLNr ; ; Is de toelevering voor een 'DO'-klant IsDOToe(TOENr) New R,IsDO,LEVNr,BLKLNr Set IsDO=0,LEVNr=$P(^KTO1(TOENr),D),BLKLNr=$P(^KTO(LEVNr,TOENr,1),D,9) Set:BLKLNr IsDO=$P(^BLBeri("K",BLKLNr),D,6)="DO" Quit IsDO ; ; Is het een product voor een 'DO'-klant IsDOProd(PRNr) New R,IsDO,KLNr,BLKLNr Set IsDO=0,KLNr="" For Set KLNr=$O(^PRPUTZ("N",PRNr,KLNr)) Quit:KLNr="" Do Quit:IsDO . Set BLKLNr=$P(^PRPUTZ("N",PRNr,KLNr,0),D) . Set IsDO=$P(^BLBeri("K",BLKLNr),D,6)="DO" Quit IsDO ; ; Is de toelevering enkel voor Halux? IsOnlyHalux(TOENr) New IsOnlyHalux,LEVNr,TLNr,PRNr,PRCount Set IsOnlyHalux=1,LEVNr=$P(^KTO1(TOENr),D),TLNr=99,PRCount=0 For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do Quit:'IsOnlyHalux . Set PRNr=$P(^KTO(LEVNr,TOENr,TLNr),D,2) . Set:PRNr IsOnlyHalux=$$IsOnlyHalux^PRODUKT2(PRNr),PRCount=PRCount+1 Set:'PRCount IsOnlyHalux=0 Quit IsOnlyHalux ; ; Bevat de toelevering houtproducten? BevatHout(TOENr) New BevatHout,LEVNr,TLNr,PRNr,PRCount Set BevatHout=0,LEVNr=$P(^KTO1(TOENr),D),TLNr=99 For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do Quit:BevatHout . Set PRNr=$P(^KTO(LEVNr,TOENr,TLNr),D,2) . Set:PRNr BevatHout=$$IsHout^PRODUKT2(PRNr) Quit BevatHout ; COMMENT(ComRef) New I,R,T1,T2 Set R=$S(ComRef="":1,1:$S($O(@(ComRef_"("""")"))="":1,1:2)) Set T1="Toelevering "_TLNr_" werd "_$P("niet ",D,R)_"opgesplitst" If ComRef="ABNr" Set T1=T1_".",T2="Het AB-nummer "_ABNr_" is reeds ingevuld" If ComRef="NTLNr" Do .Set T1=T1_" in : ",T2=TLNr_"," .For I=1:1 Set R=$O(@(ComRef_"(R)")) Quit:R="" Do ..Set T2=T2_" "_R_"," Quit:I'=9 ..Set T1=T1_$P(T2,",",1,4),T2=$P(T2,",",5,99) .Set T2=$E(T2,1,$L(T2)-1) .If I>8 Set T2=$J("",$L(T1)-$L(T2))_T2 If $D(T2) Set T2=T2_" [] ok" Else Set T1=T1_" [] = ok" If $D(T2) Set T1=T1_$J("",$L(T2)-$L(T1)) Set T2=T2_$J("",$L(T1)-$L(T2)) Set FP=$S($L(ComRef):22,1:23)*100+1 Write @F,@F1,!,@FMTI,T1 Write:$D(T2) !,T2 Write @FMTi Do IK^PROC1 Quit ; ; Overbrengen van een lijn naar een andere toelevering TMOVE(LEVNr,TLNr,MoveTLNr,TLLNr,BackGrnd) New R,TOENr,TOELNr,DERDENr,NoSelNr,PRNr,ABNr,KC,LC Set BackGrnd=$G(BackGrnd) If $$CHECKWMS^FLOW(TLNr,TLLNr,,,,,'BackGrnd) Quit MoveTLNr Set R=^KTO(LEVNr,TLNr,1),DERDENr("K")=$P(R,D,8),DERDENr("L")=LEVNr,NoSelNr(TLNr)="" Set TOENr=$G(MoveTLNr) If 'TOENr Do Quit:TOENr="-" MoveTLNr .If BackGrnd Set:TOENr'="A" TOENr="-" Quit .Set TOENr=$$SELECT^FLOW("KTO","KTO1","",.NoSelNr,.DERDENr) If TOENr="A" Set TOENr=$$GETNUM^FLOW("KTO","KTO1") If 'BackGrnd Set R=$$^vhTXTPOP("FLOWTOE","TMOVE","",TOENr) Quit:R'="J" MoveTLNr If '$D(^KTO(LEVNr,TOENr)) Do .Set R=^KTO(LEVNr,TLNr,1),ABNr=$P(R,D,10),$P(R,D,2)=DT,^KTO(LEVNr,TOENr,1)=R .Set ^KTO(LEVNr,TOENr,0)=101,^KTO1(TOENr)=LEVNr_D,^KTO2(LEVNr,TOENr)="" .Do SET^KTO4(LEVNr,TOENr,ABNr) .Do ##class(DOM.AKP.event.ToeleveringEventRaiser).RaiseToeleveringGemaaktEvent(TOENr) Set MoveTLNr=TOENr,TOELNr=^KTO(LEVNr,TOENr,0),^KTO(LEVNr,TOENr,0)=TOELNr+1 Do LMOVE(TLNr,TLLNr,TOENr,TOELNr) If 'BackGrnd Do .Do DELETE^PROC3 .Set PRNr=$P(^KTO(LEVNr,TOENr,TOELNr),D,2) Do:PRNr PRCOUNT^FLOW("-","KTO") Quit MoveTLNr ; DELLINE(TLNr,TLLNr,Extern) New %TC,R,LEVNr,PRNr,KLNr,ORDNr,OLNr,ABNr,TLUNr,BLLNr Set Extern=$G(Extern),LEVNr=$P(^KTO1(TLNr),D),R=^KTO(LEVNr,TLNr,TLLNr),PRNr=$P(R,D,2),TLUNr=$P(R,D,15) For Do ADD^vhLock("^KTO(LEVNr,TLNr,TLLNr)") Quit:%TC Do LDISP^vhLock("^KTO(LEVNr,TLNr,TLLNr)","Toelevering "_TLNr) If PRNr Do .For Do ADD^vhLock("^KPR(PRNr)") Quit:%TC Do LDISP^vhLock("^KPR(PRNr)","Produkt "_$P(^KPR(PRNr,0),D)) .Set BLLNr=$P(R,D,13,14),ORDNr=$P(R,D,27),OLNr=$P($P(R,D,28),";") .Do KWNODE^FLOWTOE(LEVNr,TLNr,TLLNr) .Kill ^KTO3(TLNr,BLLNr_D_TLLNr) .Kill ^HADPR("F",TLNr_";"_TLUNr) .Do REMOVE^vhLock("^KPR(PRNr)") .Quit:'ORDNr .Kill ^KTOK(LEVNr,TLNr,TLLNr) .Quit:Extern .Set KLNr=$P(^KO1(ORDNr,"F"),D) .Do DELLINE^FLOWORD3(ORDNr,OLNr,1) .Do RecalcCommKort^FLOWMANL("KOD",KLNr,ORDNr) Do ProductToeleveringLijnAnnulatie^FLOWTOE2(LEVNr,TLNr,TLLNr) Kill ^KTO(LEVNr,TLNr,TLLNr) If Extern,$O(^KTO(LEVNr,TLNr,100))="" Do .Do VerwijderToelevering(LEVNr,TLNr) Do REMOVE^vhLock("^KTO(LEVNr,TLNr,TLLNr)") Quit ; DELOBJ(TLNr) New %TC,LEVNr,TLLNr Set LEVNr=$P(^KTO1(TLNr),D),TLLNr=100 For Do ADD^vhLock("^KTO(LEVNr,TLNr)") Quit:%TC Do LDISP^vhLock("^KTO(LEVNr,TLNr)","Toelevering "_TLNr) For Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr="" Do DELLINE(TLNr,TLLNr) Do VerwijderToelevering(LEVNr,TLNr) Do REMOVE^vhLock("^KTO(LEVNr,TLNr)") Quit VerwijderToelevering(LEVNr,TLNr) New ABNr Set ABNr=$P(^KTO(LEVNr,TLNr,1),"\",10) Kill ^KTO1(TLNr),^KTO2(LEVNr,TLNr),^KTO(LEVNr,TLNr),^BLBeri("Z",TLNr) Do ##class(BL.Legacy.Toelevering).VerwijderAlleIndexen(TLNr) Do ##class(DOM.AKP.ToeleveringPrintbak).VerwijderToelevering(TLNr) Do:(LEVNr=5005) ##class(APPS.EDIExport.AankoopOrderResponse.BLUM.impl.BLOrdRspService).%New().VerwijderToelevering(TLNr) Do KILLAB(LEVNr,TLNr,ABNr) Do ##class(DOM.AKP.event.ToeleveringEventRaiser).RaiseToeleveringVerwijderdEvent(TLNr) ; CHKDEL(TLNr) New R,LEVNr,TLLNr,LineTyp Set LEVNr=$P($G(^KTO1(TLNr)),D) Do:LEVNr .Set TLLNr=100 .For Set TLLNr=$O(^KTO(LEVNr,TLNr,TLLNr)) Quit:TLLNr="" Do Quit:"\KTO11\"'[(D_LineTyp_D) ..Set R=^KTO(LEVNr,TLNr,TLLNr),LineTyp=$P($P(R,D,17),"#") .Do:'TLLNr DELOBJ(TLNr) Quit ; BUILDOBJ(PRNr,ToeRef,BackGrnd,EDIORDNr,FBRef) New R Set ToeRef=$G(ToeRef,"STOCK"),BackGrnd=$G(BackGrnd),EDIORDNr=$G(EDIORDNr),FBRef=$G(FBRef) Set R=$S(BackGrnd:"BUILDBGR",1:$S(EDIORDNr:"BUILDEDI",1:"BUILDFGR")) If EDIORDNr Set R=R_"(EDIORDNr,FBRef)" Else Set R=R_"(.PRNr,ToeRef)" Do @R Quit ; BUILDBGR(PRNr,ToeRef) New R,Next,LEVNr,TOENr,Aantal,LevTerm,ORDNr,OLUNr,TLUNr,InventTransId,ConfigId,MaatwerkGenerischItemId Set ToeRef=$G(ToeRef,"STOCK"),(Next,LEVNr)="" For Set Next=$O(PRNr(Next)) Quit:Next="" Do Quit:LEVNr=0 .Set PRNr=$P(PRNr(Next),D) .Quit:'PRNr .If '$D(^KPR(PRNr)) Set LEVNr=0 Quit .Set R=$O(^KPR(PRNr,"J")) .Quit:$E(R)'="J" .Set R=^KPR(PRNr,R) Set:LEVNr="" LEVNr=$P(R,D) Set:LEVNr'=$P(R,D) LEVNr=0 ; Alle producten moeten van de zelfde leverancier zijn If LEVNr Do .Set TOENr=$$GETNUM^FLOW("KTO","KTO1") .Set ^KTO(LEVNr,TOENr,0)=101 .Set ^KTO1(TOENr)=LEVNr_D .Set R="",$P(R,D,26)="",$P(R,D,2)=DT,$P(R,D,3)=ToeRef,$P(R,D,6)=LEVNr .Set ^KTO(LEVNr,TOENr,1)=R .Set Next="" .For Set Next=$O(PRNr(Next)) Quit:Next="" Do ..Set R=PRNr(Next),PRNr=$P(R,D),Aantal=$P(R,D,2),LevTerm=$P(R,D,3),ORDNr=$P(R,D,4),OLUNr=$P(R,D,5),InventTransId=$P(R,D,6),ConfigId=$P(R,D,7),MaatwerkGenerischItemId=$P(R,D,8) ..Do BUILDLN(LEVNr,TOENr,PRNr,Aantal,LevTerm,InventTransId,ConfigId,MaatwerkGenerischItemId) ..If $L($G(FBRef)),ORDNr,OLUNr Do ...Set R=$G(@FBRef@(PRNr,"TLUNr")),TLUNr=$P(R,D,$L(R,D)) ...Quit:'TLUNr ...Set @FBRef@(PRNr,"KomLink",$O(@FBRef@(PRNr,"KomLink",""),-1)+1)=TOENr_D_TLUNr_D_ORDNr_D_OLUNr .Do ##class(DOM.AKP.ToeleveringPrintbak).VoegToeToelevering(TOENr,LEVNr) .Set ^KTO2(LEVNr,TOENr)="" .Set:LEVNr=5005 ^BLBeri("Z",TOENr)=LEVNr_D .Do ##class(DOM.AKP.event.ToeleveringEventRaiser).RaiseToeleveringGemaaktEvent(TOENr) Quit ; BUILDFGR(PRNr,ToeRef) New R,Next,LEVNr,TOENr,Aantal,LevTerm Set ToeRef=$G(ToeRef,"STOCK"),(Next,LEVNr)="" For Set Next=$O(PRNr(Next)) Quit:Next="" Do Quit:LEVNr=0 .Set PRNr=$P(PRNr(Next),D) .Quit:'PRNr .If '$D(^KPR(PRNr)) Set LEVNr=0 Quit .Set R=$O(^KPR(PRNr,"J")) .Quit:$E(R)'="J" .Set R=^KPR(PRNr,R) Set:LEVNr="" LEVNr=$P(R,D) Set:LEVNr'=$P(R,D) LEVNr=0 ; Alle producten moeten van de zelfde leverancier zijn If LEVNr Do .Do AutoVerwerkToelevering^Flow.Toelev.VerwerkDoc(LEVNr,ToeRef,.PRNr) Quit ; BUILDEDI(EDIORDNr,FBRef) New EDIKLNr,ToeRef,BINr,Next,LEVNr,PRNr,R Set EDIKLNr="",BINr=$P(EDIORDNr,".") For Set EDIKLNr=$O(^MBLOG("EDI",EDIKLNr)) Quit:EDIKLNr="" Quit:$D(^MBLOG("EDI",EDIKLNr,BINr,EDIORDNr)) Do:EDIKLNr .Set ToeRef=$P(^KKL(^KK1(EDIKLNr),0),D,2)_" "_BINr .Set (Next,LEVNr)="" .For Set Next=$O(^MBLOG("EDI",EDIKLNr,BINr,EDIORDNr,Next)) Quit:Next="" Do Quit:LEVNr=0 ..Set PRNr=$P($P(^MBLOG("EDI",EDIKLNr,BINr,EDIORDNr,Next),D,2),"#") ..Quit:'PRNr ..If '$D(^KPR(PRNr)) Set LEVNr=0 Quit ..Set R=$O(^KPR(PRNr,"J")) ..Quit:$E(R)'="J" ..Set R=^KPR(PRNr,R) Set:LEVNr="" LEVNr=$P(R,D) Set:LEVNr'=$P(R,D) LEVNr=0 ; Alle producten moeten van de zelfde leverancier zijn .Quit:'LEVNr .Do AutoVerwerkToelevering^Flow.Toelev.VerwerkDoc(LEVNr,ToeRef,,EDIORDNr,,FBRef) Quit ; BUILDLN(LEVNr,TLNr,PRNr,Aantal,LevTerm,InventTransId,ConfigId,MaatwerkGenerischItemId) New R,Prijs,Munt,Eenheid,LijstPr,Korting1,Korting2,NEenheid If LevTerm="" Do .Set R=^KPR(PRNr,"J"_LEVNr),LevTerm=$P(R,D,7) .Set LevTerm=$$EXTDATE^vhLib.DataTypes($H+(LevTerm*7),"DW") Set R=$$LEVPR^KPRIJS(LEVNr,PRNr) Set Prijs=$P(R,D),Munt=$P(R,D,2),Eenheid=$P(R,D,3),LijstPr=$P(R,D,4),Korting1=$P(R,D,5),Korting2=$P(R,D,6),NEenheid=$P(R,D,11) Set R="",$P(R,D,36)="",$P(R,D,2)=PRNr,$P(R,D,3)=Aantal,$P(R,D,6)=LijstPr,$P(R,D,7)=Korting1_"#"_Korting2 Set ($P(R,D,9),$P(R,D,10))=$J(Prijs*Aantal/NEenheid,0,2),$P(R,D,16)=$J(LijstPr*Aantal/NEenheid,0,2) Set $P(R,D,12)="L",$P(R,D,17)="KTRPL",$P(R,D,21)=Eenheid,$P(R,D,22)=Munt,$P(R,D,25)=LevTerm Set $P(R,D,55)=InventTransId,$P(R,D,56)=ConfigId,$P(R,D,57)=MaatwerkGenerischItemId Do INSERT^FLOWTOE2(R,"E",,0) Set R=^KTO(LEVNr,TLNr,1) If $P(R,D,18)="" Set $P(R,D,18)=Munt,^KTO(LEVNr,TLNr,1)=R Quit ; SETAB(LEVNr,TLNr,ABNr) Set ABNr=$$UPTRIMAN^vhRtn1(ABNr) Set ^KTO4(LEVNr,ABNr_D_TLNr)="" Quit ; KILLAB(LEVNr,TLNr,ABNr) Set ABNr=$$UPTRIMAN^vhRtn1(ABNr) Kill ^KTO4(LEVNr,ABNr_D_TLNr) Quit ; BUILDTO(LEVNr,TOENr,TLNr) Set LEVNr=$G(LEVNr,0),TOENr=$G(TOENr),TLNr=$G(TLNr) Do BUILDIU(LEVNr,TOENr,TLNr) Do BUILDIP(LEVNr,TOENr,TLNr) Quit ; BUILDIU(LEVNr,TOENr,TLNr) New R,OneLev,OneToe,OneLine,PRNr,TLUNr Set LEVNr=$G(LEVNr,0),TOENr=$G(TOENr),TLNr=$G(TLNr) Set (OneLev,OneToe,OneLine)=0 Set:LEVNr OneLev=1 Set:TOENr OneToe=1 Set:TLNr OneLine=1 For Set:'OneLev LEVNr=$O(^KTO(LEVNr)) Quit:LEVNr="" Do Quit:OneLev .Set:'OneToe TOENr=0 .For Set:'OneToe TOENr=$O(^KTO(LEVNr,TOENr)) Quit:TOENr="" Do Quit:OneToe ..Set:'OneLine TLNr=100 ..For Set:'OneLine TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do Quit:OneLine ...Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),TLUNr=$P(R,D,15) ...If 'TLUNr Set TLUNr=$$UNIEKLNR^FLOWTOE(LEVNr,TOENr),$P(R,D,15)=TLUNr,^KTO(LEVNr,TOENr,TLNr)=R ...Quit:'PRNr ...Set ^TO("IU",TOENr,TLUNr)=TLNr Quit ; BUILDIP(LEVNr,TOENr,TLNr) New R,OneLev,OneToe,OneLine,TLUNr,PRNr Set LEVNr=$G(LEVNr,0),TOENr=$G(TOENr),TLNr=$G(TLNr) Set (OneLev,OneToe,OneLine)=0 Set:LEVNr OneLev=1 Set:TOENr OneToe=1 Set:TLNr OneLine=1 For Set:'OneLev LEVNr=$O(^KTO(LEVNr)) Quit:LEVNr="" Do Quit:OneLev .Set:'OneToe TOENr=0 .For Set:'OneToe TOENr=$O(^KTO(LEVNr,TOENr)) Quit:TOENr="" Do Quit:OneToe ..Set:'OneLine TLNr=100 ..For Set:'OneLine TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do Quit:OneLine ...Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),TLUNr=$P(R,D,15) ...If 'TLUNr Set TLUNr=$$UNIEKLNR^FLOWTOE(LEVNr,TOENr),$P(R,D,15)=TLUNr,^KTO(LEVNr,TOENr,TLNr)=R ...Quit:'PRNr ...Set ^TO("IP",PRNr,TOENr,TLUNr)=TLNr Quit ; DELTO(LEVNr,TOENr,TLNr) Set LEVNr=$G(LEVNr,0),TOENr=$G(TOENr),TLNr=$G(TLNr) Do DELIU(LEVNr,TOENr,TLNr) Do DELIP(LEVNr,TOENr,TLNr) Quit ; DELIU(LEVNr,TOENr,TLNr) New R,OneLev,OneToe,OneLine,TLUNr,PRNr Set LEVNr=$G(LEVNr,0),TOENr=$G(TOENr),TLNr=$G(TLNr) Set (OneLev,OneToe,OneLine)=0 Set:LEVNr OneLev=1 Set:TOENr OneToe=1 Set:TLNr OneLine=1 For Set:'OneLev LEVNr=$O(^KTO(LEVNr)) Quit:LEVNr="" Do Quit:OneLev .Set:'OneToe TOENr=0 .For Set:'OneToe TOENr=$O(^KTO(LEVNr,TOENr)) Quit:TOENr="" Do Quit:OneToe ..Set:'OneLine TLNr=100 ..For Set:'OneLine TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do Quit:OneLine ...Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),TLUNr=$P(R,D,15) ...If 'TLUNr Set TLUNr=$$UNIEKLNR^FLOWTOE(LEVNr,TOENr),$P(R,D,15)=TLUNr,^KTO(LEVNr,TOENr,TLNr)=R ...Quit:'PRNr ...Kill ^TO("IU",TOENr,TLUNr) Quit ; DELIP(LEVNr,TOENr,TLNr) New R,OneLev,OneToe,OneLine,TLUNr,PRNr Set LEVNr=$G(LEVNr,0),TOENr=$G(TOENr),TLNr=$G(TLNr) Set (OneLev,OneToe,OneLine)=0 Set:LEVNr OneLev=1 Set:TOENr OneToe=1 Set:TLNr OneLine=1 For Set:'OneLev LEVNr=$O(^KTO(LEVNr)) Quit:LEVNr="" Do Quit:OneLev .Set:'OneToe TOENr=0 .For Set:'OneToe TOENr=$O(^KTO(LEVNr,TOENr)) Quit:TOENr="" Do Quit:OneToe ..Set:'OneLine TLNr=100 ..For Set:'OneLine TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do Quit:OneLine ...Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),TLUNr=$P(R,D,15) ...If 'TLUNr Set TLUNr=$$UNIEKLNR^FLOWTOE(LEVNr,TOENr),$P(R,D,15)=TLUNr,^KTO(LEVNr,TOENr,TLNr)=R ...Quit:'PRNr ...Kill ^TO("IP",PRNr,TOENr,TLUNr) Quit ; CHECKTO Do .New Check .Set Q="K" .Do ^cA604 Write !!,"*** WMS toe ***" Set LEVNr=0 For Set LEVNr=$O(^KTO(LEVNr)) Quit:'LEVNr Do .Set Leverancier=LEVNr_" "_$P(^KLE(^KL1(LEVNr),0),D,2),TOENr="" .For Set TOENr=$O(^KTO(LEVNr,TOENr)) Quit:'TOENr Do ..Kill TLUNr ..Set TLNr=100 ..For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:'TLNr Do ...Set R=^KTO(LEVNr,TOENr,TLNr),ZR=$ZR,PRNr=$P(R,D,2),TLUNr=$P(R,D,15) ...If 'TLUNr Do Quit ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Toelevering lijn ",ZR," TLUNr onbekend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr,?50,"Lijn = ",TLNr ...Set TLUNr(TLUNr)="" ...Quit:'PRNr ...If '$D(^TO("IU",TOENr,TLUNr)) Do ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",$ZR," onbekend",!?8,"Toelev = ",TOENr,?29,"TLUNr = ",TLUNr,?50,"Lijn = ",TLNr ...If $D(^TO("IU",TOENr,TLUNr)),^TO("IU",TOENr,TLUNr)'=TLNr Do ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",$ZR," lijnnummer verschillend",!?8,"Toelev = ",TOENr,?29,"TLUNr = ",TLUNr,?50,"Lijn ",TLNr," <> ",^TO("IU",TOENr,TLUNr) ...If '$D(^TO("IP",PRNr,TOENr,TLUNr)) Do ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",$ZR," onbekend",!?8,"Toelev = ",TOENr,?29,"TLUNr = ",TLUNr,?50,"Lijn = ",TLNr ...If $D(^TO("IP",PRNr,TOENr,TLUNr)),^TO("IP",PRNr,TOENr,TLUNr)'=TLNr Do ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",$ZR," lijnnummer verschillend",!?8,"Toelev = ",TOENr,?29,"TLUNr = ",TLUNr,?50,"Lijn ",TLNr," <> ",^TO("IP",PRNr,TOENr,TLUNr) ..If $G(^KTO(LEVNr,TOENr,4))*100'>$O(TLUNr(""),-1) Do ...Set Check=0 ...Do wLEVERANCIER^zbcheck ...Write !!,"Teller TLUNr ",$ZR," foutief",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr,?50,"Teller ",$G(^KTO(LEVNr,TOENr,4)),"*100"," '> ",$O(TLUNr(""),-1) Set TOENr="" For Set TOENr=$O(^TO("IU",TOENr)) Quit:'TOENr Do .Set TLUNr="" .For Set TLUNr=$O(^TO("IU",TOENr,TLUNr)) Quit:'TLUNr Do ..Set R=^TO("IU",TOENr,TLUNr),ZR=$ZR,TLNr=$P(R,D) ..Set LEVNr=$P($G(^KTO1(TOENr)),D) ..If 'LEVNr Do Quit ...Set Check=0 ...Write !!,"Index ",ZR," toelevering onbekend",!,?8,"Toelev = ",TOENr ..Set Leverancier=LEVNr_" "_$P(^KLE(^KL1(LEVNr),0),D,2) ..If '$D(^KTO(LEVNr,TOENr)) Do Quit ...Set Check=0 ...Do wLEVERANCIER^zbcheck ...Write !!,"Index ",ZR," toelevering onbekend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr ..Set R=$G(^KTO(LEVNr,TOENr,TLNr)) ..If R="" Do Quit ...Set Check=0 ...Do wLEVERANCIER^zbcheck ...Write !!,"Index ",ZR," toelevering lijn onbekend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr,?50,"Lijn ",TLNr ..If $P(R,D,15)'=TLUNr Do ...Set Check=0 ...Do wLEVERANCIER^zbcheck ...Write !!,"Index ",ZR," TLUNr verschillend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr,?50,"TLUNr ",TLUNr," <> ",$P(R,D,15) Set PRNr="" For Set PRNr=$O(^TO("IP",PRNr)) Quit:'PRNr Do .Set TOENr="" .For Set TOENr=$O(^TO("IP",PRNr,TOENr)) Quit:'TOENr Do ..Set TLUNr="" ..For Set TLUNr=$O(^TO("IP",PRNr,TOENr,TLUNr)) Quit:'TLUNr Do ...Set R=^TO("IP",PRNr,TOENr,TLUNr),ZR=$ZR,TLNr=$P(R,D) ...Set LEVNr=$P($G(^KTO1(TOENr)),D) ...If 'LEVNr Do Quit ....Set Check=0 ....Write !!,"Index ",ZR," toelevering onbekend",!,?8,"Toelev = ",TOENr ...Set Leverancier=LEVNr_" "_$P(^KLE(^KL1(LEVNr),0),D,2) ...If '$D(^KTO(LEVNr,TOENr)) Do Quit ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",ZR," toelevering onbekend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr ...Set R=$G(^KTO(LEVNr,TOENr,TLNr)) ...If R="" Do Quit ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",ZR," toelevering lijn onbekend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr,?50,"Lijn ",TLNr ...If $P(R,D,2)'=PRNr Do ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",ZR," product verschillend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr,?50,"Product ",PRNr," <> ",$P(R,D,2) ...If $P(R,D,15)'=TLUNr Do ....Set Check=0 ....Do wLEVERANCIER^zbcheck ....Write !!,"Index ",ZR," TLUNr verschillend",!,?8,"Leveranc = ",LEVNr,?29,"Toelev = ",TOENr,?50,"TLUNr ",TLUNr," <> ",$P(R,D,15) Quit ; CHECK() New Set Check=1 Do CHECKTO Quit Check ; MAXLINES(TOENr,MaxLines) New LEVNr,TLNr,LCount,NewTOENr If $G(TOENr) Do .Set LEVNr=$P(^KTO1(TOENr),D),TOENr(TOENr)="",LCount=0,TLNr=100 .For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Set LCount=LCount+1 .Quit:LCount'>MaxLines .Set LCount=0,TLNr=100,NewTOENr="A" .For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Set LCount=LCount+1 Quit:LCount=MaxLines .For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do ..Set NewTOENr=$$TMOVE(LEVNr,TOENr,NewTOENr,TLNr,1) .Set TOENr=NewTOENr .Do MAXLINES(.TOENr,MaxLines) Quit ; AUTOTOE New R,Next,Aantal,LevTerm,Prijs,Text,BlockId Set Next="" For Set Next=$O(PRNr(Next)) Quit:Next="" Do .Set ScrolToe=1 .Set R=PRNr(Next) .If $P(R,D)="T" Do ..Set Text=$P(R,D,2),BlockId=$P(R,D,3) ..Do TINSERT^FLOWTOE(,,Text,,BlockId) .Else Do ..Set PRNr=$P(R,D),Aantal=$P(R,D,2),LevTerm=$P(R,D,3),Prijs=$P(R,D,4) ..Do PINSERT^FLOWTOE(,,PRNr,Aantal,Prijs,,,LevTerm) Kill PRNr Quit ; ; Opsplitsen van de producten enkel voor Halux in een apparte toelevering ; + extra splits toegevoegd .. Baliko , Dekaply --> per kleur.. ; + extra split KAD & TBX SplitHaluxProd(TOENr,NTLNr) New R,LEVNr,TLNr,NTOENr,LCount, TLUNr,PRNr,OrderLijnVolgnummer, UniekeClassificatieCode New arSplit,SortKey,LastSortKey,Leverdag New Toelevering,KlantID,Product,ProductAPI,AdHocSplitser New ProductieService,ToeleveringSplitser, ToeleveringSplitserBepaler, Aantal Set ProductieService = ##class(APPS.Halux.common.ProductieService).%New() Set ProductAPI = ##class(DOM.DomeinContext).Instance().GeefProductAPI() Set Toelevering = ##class(DOM.DomeinContext).Instance().GeefToeleveringAPI().GeefToelevering(TOENr) Set ToeleveringSplitserBepaler = ##class(APPS.Halux.common.impl.ToeleveringSplitserBepaler).%New() Set ToeleveringSplitser = ToeleveringSplitserBepaler.GeefToeleveringSplitser(Toelevering) Set AdHocSplitser = ##class(BL.Legacy.FLOWTOE.AdHocSplitser).%New() Set KlantID = Toelevering.GeefKlantID() Set LEVNr=$P(^KTO1(TOENr),D),TLNr=100 #dim Product As DOM.PM.Product // SortKey dient niet voor sortering, maar voor het aanduiden welke lijnen samen mogen blijven, en welke niet. For Set TLNr=$O(^KTO(LEVNr,TOENr,TLNr)) Quit:TLNr="" Do . Set R=^KTO(LEVNr,TOENr,TLNr),PRNr=$P(R,D,2),OrderLijnVolgnummer=$P(R,D,28) . Set SortKey="0000" // default sortkey . If PRNr Do . . set Product = ProductAPI.GeefProduct(PRNr) . . If $$IsOnlyHalux^PRODUKT2(PRNr) do . . . Set SortKey=$$$LevHalux . . If ((LEVNr=$$$LevBaliko)||(LEVNr=$$$LevStylinArt)||(LEVNr=$$$LevUnilin)) do // laatste 4 codes van korttekst (kleur) . . . Set SortKey = LEVNr_"."_$E($$$PRGet($$$KortTekst),22,25) . . Else Do . . . If LEVNr=$$$LevHalux Do . . . . Set Leverdag = ##class(BL.Legacy.FLOWTOE).GeefLeverdag(Toelevering,TLNr) . . . . Set:($Length(Leverdag)) SortKey = ProductieService.GeefCategorie(Product.GeefID())_" "_ProductieService.GeefProductieGroep(KlantID,Product.GeefID(),ToeleveringSplitser)_" "_Leverdag . . . . Set UniekeClassificatieCode = ##class(BL.Legacy.FLOWTOE).GeefUniekeClassificatieCode(PRNr) . . If ($$IsGlassetProduct(UniekeClassificatieCode) || $$IsVerzagingProduct(UniekeClassificatieCode) || $$IsCabloxxProduct(UniekeClassificatieCode)) Do . . . Set Leverdag = ##class(BL.Legacy.FLOWTOE).GeefLeverdag(Toelevering,TLNr) . . . Set:($Length(Leverdag)) SortKey = UniekeClassificatieCode_ProductieService.GeefProductieGroep(KlantID,Product.GeefID(),ToeleveringSplitser)_" "_Leverdag . . . . If ##class(BL.Legacy.FLOWTOE).IsToeleveringLijnVoorSpaceTowerProduct(Toelevering,TLNr) Set SortKey = OrderLijnVolgnummer . . . . // Ad hoc splitsing van bvb. specifieke te grote toeleveringen kan gebeuren door aan SortKey iets te appenden, zoals een kenmerk van een lade. . . Do:(AdHocSplitser.IsAdHocSplitsingActief(TOENr)) AdHocSplitser.PasAanSortKeyViaMapping(.SortKey,Product,TOENr,TLNr,KlantID) . Else Set SortKey=$G(LastSortKey) . Set:'$L(SortKey) SortKey="0000" . If 'PRNr,'$D(arSplit(SortKey)) Set arSplit("~~~~",TLNr)="" Quit ; Tekst eventueel op wacht zetten voor bij eerstvolgende productgroep . Merge arSplit(SortKey)=arSplit("~~~~") Kill arSplit("~~~~") ; Wachtende lijnen toevoegen . Set arSplit(SortKey,TLNr)="" . Set LastSortKey = SortKey If $D(arSplit("~~~~")) Set SortKey=$O(arSplit("")) Merge arSplit(SortKey)=arSplit("~~~~") Kill arSplit("~~~~") ; Eventueel nog wachtende lijnen aan de eerste groep toevoegen Quit:$O(arSplit($O(arSplit(""))))="" // geen split nodig indien alles onder de zelfde sortkey valt Set SortKey=$O(arSplit("")) //eerste index blijft altijd op originele bon staan For Set SortKey=$O(arSplit(SortKey)) Quit:SortKey="" Do . Set NTOENr=$$GETNUM^FLOW("KTO","KTO1"),NTLNr(NTOENr)="" . Set R=^KTO(LEVNr,TOENr,1),^KTO(LEVNr,NTOENr,1)=R . Set ^KTO1(NTOENr)=LEVNr_D . Set (TLNr,LCount)=100 . For Set TLNr=$O(arSplit(SortKey,TLNr)) Quit:TLNr="" Do . . Set LCount=LCount+1 . . Do LMOVE(TOENr,TLNr,NTOENr,LCount) . Set ^KTO(LEVNr,NTOENr,0)=$$NEXTFREE(LEVNr,NTOENr),TLUNr=$$NEXTTLUNR(LEVNr,NTOENr)\100 . Set:$G(^KTO(LEVNr,NTOENr,4))