TRANSPZ ;Verwerking expediteur (vrij transport) [ 04/14/2003  11:42 AM ]
 ;
VERWERK(VervRef,ContactType,ContactRef)
 New R,Obj
 If $L(ContactType),$L(ContactRef) Set R=ContactType_";"_ContactRef
 Else  If ContactType="K" Set R=$$SELECT^KONTAKT("K",,,"Klant : ")
 Else  If ContactType="L" Set R=$$SELECT^KONTAKT("L",,,"Leverancier : ")
 Else  Set R=$$SELECT^KONTAKT("D",,,"Derde : ")
 Do:R'="-"
 . Set ContactType=$P(R,";"),ContactRef=$P(R,";",2)
 . If $D(^TRANSP("D",VervRef,"D",ContactRef)) Do
 . . Set Obj=##class(Flow.Cons.TransportAdres).%OpenId(VervRef_"||"_ContactRef),ContactType=Obj.ContactType
 . . Set Warn=##class(CHUI.Flow.Cons.Transport).ContactExistInTransport(VervRef,ContactType,ContactRef)
 . . Quit:Warn="A"
 . . If Warn="V" Do ##class(BL.Flow.Cons.TransportFlow).DeleteContact(VervRef,ContactRef) Quit
 . . Do MODCONTACT(VervRef,ContactType,ContactRef)
 . Else  Do NEWCONTACT(VervRef,ContactType,ContactRef)
 Quit
 ;
NEWCONTACT(VervRef,ContactType,ContactRef) 
 New %SC,R,sFL,TranspNr,ModHoofding
 Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D)
 Do:$L($G(ContactRef))
 .Quit:'$$LOCK(VervRef,ContactRef)
 .Do INITCONTACT
 .Set ModHoofding=1
 .If $D(^TRANSP("D",VervRef,"D")) Set %SC=1
 .Else  If $P($G(^TRANSP("D",VervRef)),D,8) Set %SC=1
 .Else  If $L($G(^TRANSP("D",VervRef,"T"))) Set %SC=1
 .Else  Do NIEUW^vhScherm("TRANSPZ")
 .Do:%SC
 ..Set ModHoofding=0
 ..Do NIEUW^vhScherm("TRANSPZ")
 ..Do:%SC SAVECONTACT(VervRef,.sFL)
 .Do UNLOCK(VervRef,ContactRef)
 Quit
 ;
MODCONTACT(VervRef,ContactType,ContactRef) 
 New %SC,R,sFL,TranspNr,ModHoofding
 Do:$$LOCK(VervRef,ContactRef)
 .Do INITCONTACT
 .Set ModHoofding=0
 .Do EDIT^vhScherm("TRANSPZ")
 .Do:%SC SAVECONTACT(VervRef,.sFL)
 .Do UNLOCK(VervRef,ContactRef)
 Quit
 ;
MODHOOFDING(VervRef) 
 New %SC,R,sFL,TranspNr,ModHoofding,Label
 Do:$$LOCK(VervRef)
 .Set ModHoofding=1
 .Set sFL("V")=^TRANSP("D",VervRef),TranspNr=$P(sFL("V"),D)
 .Set:$P(sFL("V"),D,5)="" $P(sFL("V"),D,5)="L"
 .Set sFL("AT",1)=$G(^TRANSP("D",VervRef,"T"))
 .Set Label="EDIT"
 .If $O(^TRANSP("D",Transport,"D",""))="",'$P(sFL("V"),D,8),sFL("AT",1)="" Set Label="NIEUW"
 .Do @(Label_"^vhScherm(""TRANSPZ"")")
 .Quit:'%SC
 .Set:$P(sFL("V"),D,5)="L" $P(sFL("V"),D,5)=""
 .Set ^TRANSP("D",VervRef)=sFL("V")
 .Kill ^TRANSP("D",VervRef,"T")
 .Set:$L($G(sFL("AT",1))) ^TRANSP("D",VervRef,"T")=sFL("AT",1)
 .Do UNLOCK(VervRef)
 Quit
 ;
 ; Raadplegen transportstatus
RPLCONTACT(VervRef,ContactType,ContactRef) 
 New %SC,R,sFL,TranspNr,Ophalen,Transfer
 Do INITCONTACT
 Set R=^TRANSP("D",VervRef),Ophalen=$P(R,D,11),Transfer=$P(R,D,12)
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("TRANSPZ"),FIELD^vhScherm("TRANSPZ","OK")
 Do REFRESH^vhTERMINA()
 Quit
 ;
INITCONTACT 
 New I,R,Rembours
 Set sFL(1)=$G(^TRANSP("D",VervRef,"D",ContactRef))
 If sFL(1)="" Do
 . Set sFL(1)=ContactRef,$P(sFL(1),D,6)=ContactType
 . Set $P(sFL(1),D,9)=$$DEVUSER^vhUSER(),$P(sFL(1),D,10)=$H
 Set:$P(sFL(1),D,6)="" $P(sFL(1),D,6)="K" Set ContactType=$P(sFL(1),D,6)
 Set sFL("V")=$G(^TRANSP("D",VervRef))
 If $L(sFL("V")) Set TranspNr=$P(sFL("V"),D)
 Else  Do
 . Set sFL("V")=TranspNr,$P(sFL("V"),D,5)="L"
 . Set $P(sFL("V"),D,9)=$$DEVUSER^vhUSER(),$P(sFL("V"),D,10)=$P(sFL(1),D,10)
 . Set $P(sFL("V"),D,15)=$P($G(^TRANSP("T",TranspNr)),D,11)
 Set:$P(sFL("V"),D,5)="" $P(sFL("V"),D,5)="L"
 Set sFL("AT",1)=$G(^TRANSP("D",VervRef,"T")),sFL("T",1)=$G(^TRANSP("D",VervRef,"D",ContactRef,"T"))
 Merge sFL("Q")=^TRANSP("D",VervRef,"D",ContactRef,"Q")
 Set R=$G(^TRANSP("D",VervRef,"D",ContactRef,"A"))
 Do:R=""
 . If ContactType="K" Set R=^KKL(^KK1(ContactRef),0)
 . Else  If ContactType="L" Set R=^KLE(^KL1(ContactRef),0)
 . Else  Set R=D_ContactRef
 For I=10:1:12,14:1:18,20:1:23,26:1:$L(R,D) Set $P(R,D,I)=""
 Set sFL("L")=R
 Quit
 ;
 ; Wegschrijven van de data
SAVECONTACT(VervRef,Nodes) 
 New I,R,Next,Node,TranspNr,ContactType,ContactRef,ColTyp
 Set ContactRef=$P(Nodes(1),D),ContactType=$P(Nodes(1),D,6)
 Set:ContactType="K" $P(Nodes(1),D,6)=""
 Set:$P(Nodes("V"),D,5)="L" $P(Nodes("V"),D,5)=""
 Set ^TRANSP("D",VervRef)=Nodes("V")
 Set ^TRANSP("D",VervRef,"D",ContactRef)=Nodes(1)
 Do:"L"[ContactType  ; Controle leveringsadres gelijk aan het hoofdadres
 . Set:ContactType="" R=^KKL(^KK1(ContactRef),0)
 . Set:ContactType="L" R=^KLE(^KL1(ContactRef),0)
 . For I=10:1:12,14:1:18,20:1:23,26:1:$L(R,D) Set $P(R,D,I)=""
 . Kill:$TR($P($G(sFL("L")),D,2,99),D,"")=$TR($P(R,D,2,99),D,"") sFL("L")
 Kill ^TRANSP("D",VervRef,"D",ContactRef,"Q")
 Set ColTyp=""
 For  Set ColTyp=$O(sFL("Q",ColTyp)) Quit:ColTyp=""  Do
 .Set R=sFL("Q",ColTyp)
 .Quit:$TR(R,D,"")=""
 .Set ^TRANSP("D",VervRef,"D",ContactRef,"Q",ColTyp)=R
 Kill ^TRANSP("D",VervRef,"T"),^TRANSP("D",VervRef,"D",ContactRef,"T"),^TRANSP("D",VervRef,"D",ContactRef,"A")
 Set:$L($G(sFL("AT",1))) ^TRANSP("D",VervRef,"T")=sFL("AT",1)
 Set:$L($G(sFL("T",1))) ^TRANSP("D",VervRef,"D",ContactRef,"T")=sFL("T",1)
 If $P($G(sFL("L")),D)'=ContactRef,$L($TR($P($G(sFL("L")),D,2,99),D,"")) Set ^TRANSP("D",VervRef,"D",ContactRef,"A")=sFL("L")
 Set ^TRANSP("IO",VervRef)=""
 Do CUMVERV(VervRef)
 Do:$P(Nodes("V"),D,2)="P"
 .Quit:##class(CHUI.Flow.Cons.Transport).TransportEdited(VervRef)'="A"
 .Quit:$$BevatGeenVerpakking^TRANSPC(VervRef)
 .Do EXTERN^DCPRINT("E",VervRef,,,1)
 Quit
 ;
 ; Cumuleren van het gewicht in de hoofdnode
CUMVERV(VervRef) 
 New R,GroepNr,Gewicht,Obj
 Set (GroepNr,Gewicht)=""
 For  Set GroepNr=$O(^TRANSP("D",VervRef,"D",GroepNr)) Quit:GroepNr=""  Do
 .Set R=^TRANSP("D",VervRef,"D",GroepNr),Gewicht=Gewicht+$P(R,D,3)
 Set Obj=##class(Flow.Cons.Transport).%OpenId(VervRef)
 Do Obj.%Reload()
 Set Obj.GewichtGoederen=Gewicht,R=Obj.%Save()
 Quit
 ;
LOCK(VervRef,ContactRef) 
 New %TC,Ref,TranspNr
 If $L($G(ContactRef)) Set:ContactRef'?.N ContactRef=""""_ContactRef_""""
 Set Ref="^TRANSP(""D"",VervRef" Set:$L($G(ContactRef)) Ref=Ref_",""D"","_ContactRef Set Ref=Ref_")"
 Do ADD^vhLock($NA(@Ref))
 Do:'%TC
 .Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D)
 .Do LDISP^vhLock($NA(@Ref),$P(^KLE(^KL1(TranspNr),0),D,2))
 Quit %TC
 ;
UNLOCK(VervRef,ContactRef) 
 New Ref
 If $L($G(ContactRef)) Set:ContactRef'?.N ContactRef=""""_ContactRef_""""
 Set Ref="^TRANSP(""D"",VervRef" Set:$L($G(ContactRef)) Ref=Ref_",""D"","_ContactRef Set Ref=Ref_")"
 Do REMOVE^vhLock($NA(@Ref))
 Quit
 ;
RUBREXEC
 If X="B",'$G(ModBeheer) Set ModBeheer=1,X="-" ; Beheer transport is ingedrukt
 Quit
 ;
INITEXEC
 If $G(ModHoofding) Do
 .Do REMATTR^vhScherm("VERVREF","D","D"),REMATTR^vhScherm("OPHVOORZ","D","D")
 .Do REMATTR^vhScherm("LEVADR","D","D"),REMATTR^vhScherm("ALGOPMERK","D","D")
 .Do REMATTR^vhScherm("GROEPEER","D","D"),REMATTR^vhScherm("UITLEVDAT","D","D")
 .Do PUTATTR^vhScherm("AANMAAKZ","HD","HD")
 .Do PUTATTR^vhScherm("SCHLIJNF7","HD","HD"),PUTATTR^vhScherm("SCHLIJN","HD","HD"),PUTATTR^vhScherm("SCHLIJNF8","HD","HD")
 .Do PUTATTR^vhScherm("KLANT","HD","HD"),PUTATTR^vhScherm("LEVADR","HD","HD")
 .Do PUTATTR^vhScherm("LASTRAAT","HD","HD"),PUTATTR^vhScherm("LAWOONPL","HD","HD")
 .Do PUTATTR^vhScherm("OPMERKING","HD","HD")
 .Do PUTATTR^vhScherm("PALET","HD","HD"),PUTATTR^vhScherm("COLLIE","HD","HD")
 .Do PUTATTR^vhScherm("LANGGOED","HD","HD"),PUTATTR^vhScherm("VRACHTKOST","HD","HD")
 .Do PUTATTR^vhScherm("NETGEW","HD","HD"),PUTATTR^vhScherm("REMBOURS","HD","HD")
 Else  Do
 .Do:$G(Ophalen)!$G(Transfer) REMATTR^vhScherm("OPHALEN","H","H"),REMATTR^vhScherm("TRANSFERT","H","H")
 Quit
 ;
 ; Leveringsadres bepalen
LEVADR(sFL)
 New LevAdr,ContactType,ContactRef
 Set ContactType=$P(sFL(1),D,6)
 Set LevAdr=$G(sFL("L"))
 Set ContactRef=$S(ContactType="K":$P(sFL(1),D),1:"")
 Set FP=942
 Write @F,@F1
 Set LevAdr=$$SELECT^LEVADR(ContactRef,"HM",LevAdr)
 Set FP=2001
 Write @F,@F1
 If $L(LevAdr),$TR($P(LevAdr,D,2,99),D,"")'=$TR($P($G(sFL("L")),D,2,99),D,"") Do
 . If ContactType="K",$P(LevAdr,D) Set LevAdr=$G(^KKL(^KK1(ContactRef),"L"_$J($P(LevAdr,D),3)))
 . Set:$P(LevAdr,D)="M" $P(LevAdr,D)=1
 . Do:$P(LevAdr,D)="HOOFD" 
 . . If ContactType="K" Set LevAdr=^KKL(^KK1(ContactRef),0)
 . Set %SC=1
 . If $TR($P(LevAdr,D,2,99),D,"")="" Kill sFL("L")
 . Else  Set sFL("L")=LevAdr
 Set ContactRef=$S(ContactType="K":$P(sFL(1),D),ContactType="L":$P(sFL(1),D),1:"")
 Do REPAINT^vhScherm("")
 Quit
 ;
 ; Ophalen van de munt van het contact
MUNT(ContactType,ContactRef)
 New R,Munt,LevKey
 Set Munt=""
 If ContactType="L" Set LevKey=^KL1(ContactRef),R=^KLE(LevKey,0),Munt=$P(R,D,11)
 Else  If ContactType="K" Set Munt=$$MUNT^KLANT(ContactRef)
 Set:Munt="" Munt=$$FADEF^vhRtn1()
 Quit Munt
 ;