TRANSPX ;Verwerking expediteur [ 04/14/2003  11:42 AM ]
 ;
NEWGRP(VervRef,GroepNr,BONNrs) 
 New %SC,R,sFL,TranspNr,KLNr,Collie,ColList,Labels,OBCount
 Do INIT^vhLIST("TRANSP","COLLIE",.Collie)
 If $L($G(VervRef)) Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D)
 Else  Set R=$$SELVERV(,"N"),TranspNr=$P(R,";"),VervRef=$P(R,";",2)
 Do:$L($G(VervRef))
 .Do:TranspNr=5036 CHKVERZW(.BONNrs) ; Indien ABX
 .Set Labels=0
 .Quit:'$$LOCK(VervRef,GroepNr)
 .Do INITGRP
 .Merge ColList=sFL("Q")
 .Do NIEUW^vhScherm("TRANSP")
 .Do:%SC
 ..Kill sFL("Q")
 ..Merge sFL("Q")=ColList
 ..Do SAVEGRP(VervRef,GroepNr,.BONNrs,.sFL)
 ..Quit:TranspNr'=5036  ; Niet ABX dus geen etiketten
 ..Do:Labels
 ...If $$^vhTXTPOP("TRANSP",$S($D(^TRANSP("D",VervRef,"D",GroepNr,"C")):"NEW",1:"")_"LABEL")'="J" Set Labels=0 Quit
 ...Do LABEL^TRANSPL(VervRef,GroepNr)
 ..If 'Labels Set R=^TRANSP("D",VervRef) Set:$P(R,D,2)="P" $P(R,D,2)="",^TRANSP("D",VervRef)=R
 .Do UNLOCK(VervRef,GroepNr)
 Quit
 ;
MODGRP(VervRef,GroepNr) 
 New %SC,R,sFL,TranspNr,KLNr,BONNr,BONNrs,Collie,ColList,Labels,OBCount,NBCount,ColTyp
 Do:$$LOCK(VervRef,GroepNr)
 .Set Labels=0
 .Do INIT^vhLIST("TRANSP","COLLIE",.Collie)
 .Do:'$D(BONNrs)
 ..Set BONNr=""
 ..For  Set BONNr=$O(^TRANSP("D",VervRef,"D",GroepNr,"B",BONNr)) Quit:BONNr=""  Set BONNrs(BONNr)=""
 .Do INITGRP
 .Merge ColList=sFL("Q")
 .Do EDIT^vhScherm("TRANSP")
 .Do:%SC
 ..Kill sFL("Q")
 ..Merge sFL("Q")=ColList
 ..Do SAVEGRP(VervRef,GroepNr,.BONNrs,.sFL)
 ..Quit:TranspNr'=5036  ; Niet ABX dus geen etiketten
 ..Do:Labels
 ...Set ColTyp="",NBCount=0
 ...For  Set ColTyp=$O(^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp)) Quit:ColTyp=""  Do
 ....Set R=^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp)
 ....Set NBCount=NBCount+$P(R,D)
 ...If $G(OBCount),NBCount'=OBCount Kill ^TRANSP("D",VervRef,"D",GroepNr,"C")
 ...Quit:$$^vhTXTPOP("TRANSP",$S($D(^TRANSP("D",VervRef,"D",GroepNr,"C")):"NEW",1:"")_"LABEL")'="J"
 ...Do LABEL^TRANSPL(VervRef,GroepNr,2)
 .Do UNLOCK(VervRef,GroepNr)
 Quit
 ;
RPLGRP(VervRef,GroepNr) 
 New %SC,R,sFL,TranspNr,KLNr,Collie,ColList,Labels,OBCount,BONNr,Count,Ophalen,Transfer
 Do INIT^vhLIST("TRANSP","COLLIE",.Collie)
 Do INITGRP
 Merge ColList=sFL("Q")
 Set BONNr="",Count=0
 For  Set BONNr=$O(^TRANSP("D",VervRef,"D",GroepNr,"B",BONNr)) Quit:BONNr=""  Do
 .Set Count=Count+1,$P(ColList(Count),D)=BONNr
 Set R=^TRANSP("D",VervRef),Ophalen=$P(R,D,11),Transfer=$P(R,D,12)
 Do STORE^vhTERMINA()
 Do DISPLAY^vhScherm("TRANSP"),FIELD^vhScherm("TRANSP","OK")
 Do REFRESH^vhTERMINA()
 Quit
 ;
INITGRP 
 New R,Rembours,Rembours,Gewicht,ColTyp,Omschr,Count,BONNr,Node,BarCode
 Set R=^KU1(GroepNr,"F"),KLNr=$P(R,D),Node=$$NODE(GroepNr)
 Set R=^KUL(KLNr,Node,GroepNr,3) Set:'$P(R,D) R=^KKL(^KK1(KLNr),0)
 Set sFL("L")=R
 Set sFL(1)=$G(^TRANSP("D",VervRef,"D",GroepNr))
 Do:sFL(1)=""
 .Set (BONNr,Rembours,Gewicht)=""
 .For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do
 ..Set Node=$$NODE(BONNr)
 ..Set Rembours=Rembours+$S($$ISREMB^REMBOURS(KLNr,BONNr):$P($$BON^REMBOURS(BONNr),D),1:"")
 ..Set R=^KUL(KLNr,Node,BONNr,1),Gewicht=Gewicht+$J($P($P(R,D,13),"#",3),0,1)
 .Set sFL(1)=KLNr_D_Rembours_D_Gewicht,$P(sFL(1),D,10)=$H
 Set sFL("V")=$G(^TRANSP("D",VervRef))
 If $L(sFL("V")) Set TranspNr=$P(sFL("V"),D)
 Else  Set sFL("V")=TranspNr_D_D_Gewicht,$P(sFL("V"),D,10)=$P(sFL(1),D,10)
 Set ColTyp=""
 For  Set ColTyp=$O(^RES("EWBON","PI","COLLIETYPE","D",ColTyp)) Quit:ColTyp=""  Do
 .Set R=^RES("EWBON","PI","COLLIETYPE","D",ColTyp)
 .Quit:'$P(R,"`",3)
 .Set Count=$P(R,"`"),Omschr=$P(R,"`",2)
 .Set R=$G(^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp))
 .Set sFL("Q",0,Count)=D_ColTyp_D_Omschr_D_$P(R,D,1,2)
 Set ColTyp="",Count=0
 For  Set ColTyp=$O(sFL("Q",0,ColTyp)) Quit:ColTyp=""  Set R=sFL("Q",0,ColTyp),Count=Count+1,sFL("Q",Count)=R
 Kill sFL("Q",0)
 Set (Count,BONNr)=0
 For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Set Count=Count+1,$P(sFL("Q",Count),D)=BONNr
 Set BarCode="",Count=0
 For  Set BarCode=$O(^TRANSP("D",VervRef,"D",GroepNr,"C",BarCode)) Quit:BarCode=""  Do
 .Set (Count,OBCount)=Count+1,$P(sFL("Q",Count),D,11)=BarCode
 Merge sFL("C")=^TRANSP("D",VervRef,"D",GroepNr,"C")
 Set sFL("AO")=$G(^TRANSP("D",VervRef,"O")),sFL("O")=$G(^TRANSP("D",VervRef,"D",GroepNr,"O"))
 Quit
 ;
DELGRP(VervRef,GroepNr) 
 New R,BONNr,KLNr,Gewicht,Node
 Set BONNr="",Gewicht=0
 For  Set BONNr=$O(^TRANSP("D",VervRef,"D",GroepNr,"B",BONNr)) Quit:BONNr=""  Do
 .Set KLNr=$P(^KU1(BONNr,"F"),D),Node=$$NODE(BONNr)
 .Set R=^KUL(KLNr,Node,BONNr,1),$P(R,D,8)="",^KUL(KLNr,Node,BONNr,1)=R
 .Set Gewicht=Gewicht+$J($P($P(R,D,13),"#",3),0,1)
 Kill ^TRANSP("D",VervRef,"D",GroepNr)
 If $O(^TRANSP("D",VervRef,"D",""))="" Kill ^TRANSP("IO",VervRef),^TRANSP("D",VervRef)
 Else  Do CUMVERV(VervRef)
 Quit
 ;
SAVEGRP(VervRef,GroepNr,BONNrs,Nodes) 
 New R,BONNr,KLNr,Next,ColTyp,Node
 If $D(BONNrs) Do
 .Set BONNr=""
 .For  Set BONNr=$O(^TRANSP("D",VervRef,"D",GroepNr,"B",BONNr)) Quit:BONNr=""  Do
 ..Quit:$D(BONNrs(BONNr))
 ..Set KLNr=$P(^KU1(BONNr,"F"),D),Node=$$NODE(BONNr)
 ..Set R=^KUL(KLNr,Node,BONNr,1),$P(R,D,8)="",^KUL(KLNr,Node,BONNr,1)=R
 ..Kill ^TRANSP("D",VervRef,"D",GroepNr,"B",BONNr)
 .Set ^TRANSP("D",VervRef)=Nodes("V")
 .Set ^TRANSP("D",VervRef,"D",GroepNr)=Nodes(1),BONNr=""
 .For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do
 ..Set KLNr=$P(^KU1(BONNr,"F"),D),Node=$$NODE(BONNr)
 ..Set R=^KUL(KLNr,Node,BONNr,1),$P(R,D,8)=VervRef_";"_GroepNr,^KUL(KLNr,Node,BONNr,1)=R
 ..Set ^TRANSP("D",VervRef,"D",GroepNr,"B",BONNr)=""
 .Kill ^TRANSP("D",VervRef,"D",GroepNr,"Q")
 .Set Next=""
 .For  Set Next=$O(Nodes("Q",Next)) Quit:Next=""  Do
 ..Set R=Nodes("Q",Next),ColTyp=$P(R,D,2),R=$P(Nodes("Q",Next),D,4,10)
 ..Quit:$TR(R,D,"")=""
 ..Set ^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp)=R
 .Merge ^TRANSP("D",VervRef,"D",GroepNr,"C")=sFL("C")
 .Kill ^TRANSP("D",VervRef,"O"),^TRANSP("D",VervRef,"D",GroepNr,"O")
 .Set:$L($G(sFL("AO"))) ^TRANSP("D",VervRef,"O")=sFL("AO")
 .Set:$L($G(sFL("O"))) ^TRANSP("D",VervRef,"D",GroepNr,"O")=sFL("O")
 .Set ^TRANSP("IO",VervRef)=""
 .Do CUMVERV(VervRef)
 Quit
 ;
GETGRP(BONNr) 
 New R,KLNr,VervRef,GroepNr
 Set KLNr=$P(^KU1(BONNr,"F"),D),R=^KUL(KLNr,"F",BONNr,1),R=$P(R,D,8),VervRef=$P(R,";"),GroepNr=$P(R,";",2)
 Set R=$S($L(VervRef):VervRef_";"_GroepNr,1:"")
 Quit R
 ;
SELBON(GroepNr,BONNrs,Beperk) 
 New R,KLNr,BONNr,SelBon,BonList,OldSel,Selected,VervRef,Input,Count
 Set Beperk=$G(Beperk,1),KLNr=$P(^KU1(GroepNr,"F"),D)
 Do FETCHBON(GroepNr,.BONNrs,.BonList,Beperk)
 Do:$O(BonList(""),-1)>1
 .Do STORE^vhTERMINA()
 .Do INIT^vhLIST("TRANSP","SELBON",.SelBon)
 .Set:Beperk $P(SelBon("B",4),"`",3)="H"
 .Do WRITE^vhLIST(.SelBon)
 .For  Set Input=$$SCROLL^vhLIST(.SelBon) Quit:Input="O"  Quit:Input="A"  Do
 ..If Input="S" Do
 ...Set R=BonList(SelBon("SELECT")),BONNr=$P(R,D)
 ...If BONNr'=GroepNr Do
 ....Set $P(R,D,2)='$P(R,D,2),BonList(SelBon("SELECT"))=R
 ....If $P(R,D,2) Set BONNrs(BONNr)=""
 ....Else  Kill BONNrs(BONNr)
 ...Do REFRESH^vhLIST(.SelBon,"L",SelBon("SELECT"))
 ...Do MOVE^vhLIST(.SelBon,"DO","")
 ..If Input="V" Do
 ...Set OldSel=BonList(SelBon("SELECT")),Beperk=1
 ...Do FETCHBON(GroepNr,.BONNrs,.BonList,Beperk)
 ...Do INIT^vhLIST("TRANSP","SELBON",.SelBon)
 ...Set $P(SelBon("B",4),"`",3)="H"
 ...For SelBon("SELECT")=1:1 Quit:BonList(SelBon("SELECT"))=OldSel
 ...Do WRITE^vhLIST(.SelBon)
 .Do REFRESH^vhTERMINA()
 If $G(Input)="A" Kill BONNrs
 Else  For Count=1:1 Quit:'$D(BonList(Count))  Do
 .Set R=BonList(Count),BONNr=$P(R,D),Selected=$P(R,D,2)
 .Set:Selected BONNrs(BONNr)=""
 Quit
 
selbon(VarRef) 
 New R,RefBonNr,KLNr,BONNr,SelBon,BonList,OldSel,Selected,VervRef,GroepNr,Input,Count,TempVar
 Set RefBonNr=@VarRef@("GRPNR") ;) Set:'RefBonNr RefBonNr=$O(@VarRef@("BON",""))
 Set KLNr=$P(^KU1(RefBonNr,"F"),D)
 Merge TempVar=@VarRef
 Do FETCHBON(RefBonNr,VarRef,.BonList)
 Do:$O(BonList(""),-1)>1
 .Do STORE^vhTERMINA()
 .Do INIT^vhLIST("TRANSP","SELBON",.SelBon)
 .Set:$D(@VarRef@("ALL")) $P(SelBon("B",4),"`",3)="H"
 .Do WRITE^vhLIST(.SelBon)
 .For  Set Input=$$SCROLL^vhLIST(.SelBon) Quit:Input="O"  Quit:Input="A"  Do
 ..If Input="S" Do
 ...Set R=BonList(SelBon("SELECT")),BONNr=$P(R,D)
 ...If BONNr'=RefBonNr Do
 ....Set $P(R,D,2)='$P(R,D,2),BonList(SelBon("SELECT"))=R
 ....If $P(R,D,2) Set @VarRef@("BON",BONNr)=""
 ....Else  Kill @VarRef@("BON",BONNr)
 ...Do REFRESH^vhLIST(.SelBon,"L",SelBon("SELECT"))
 ...Do MOVE^vhLIST(.SelBon,"DO","")
 ..If Input="V" Do
 ...Set OldSel=BonList(SelBon("SELECT")),@VarRef@("ALL")=1
 ...Do FETCHBON(RefBonNr,VarRef,.BonList)
 ...Do INIT^vhLIST("TRANSP","SELBON",.SelBon)
 ...Set $P(SelBon("B",4),"`",3)="H"
 ...For SelBon("SELECT")=1:1 Quit:BonList(SelBon("SELECT"))=OldSel
 ...Do WRITE^vhLIST(.SelBon)
 .Do REFRESH^vhTERMINA()
 If $G(Input)="A" Kill @VarRef Merge @VarRef=TempVar Set @VarRef@("ANUL")=1
 Else  For Count=1:1 Quit:'$D(BonList(Count))  Do
 .Set R=BonList(Count),BONNr=$P(R,D),Selected=$P(R,D,2)
 .If 'Selected Kill @VarRef@("BON",BONNr) Quit
 .Set VervRef=$P(R,D,3),GroepNr=$P(R,D,4)
 .Set @VarRef@("BON",BONNr)=""
 .Set:$L(VervRef) @VarRef@("VERVREF")=VervRef Set:$L(GroepNr) @VarRef@("GRPNR")=GroepNr
 Quit
 ;
FETCHBON(GroepNr,BONNrs,BonList,Beperk) 
 New R,BONNr,KLNr,BonDat,MinDat,MaxDat,LevAdr,Count,Selected,VervRef,VerzW,BonStat,IsHalux,Node,RefMunt
 Set Beperk=$G(Beperk,1)
 Set KLNr=$P(^KU1(GroepNr,"F"),D),Node=$$NODE(GroepNr)
 Set R=^KUL(KLNr,Node,GroepNr,1),BonDat=$P(R,D,2),RefMunt=$P(R,D,18),LevAdr=^KUL(KLNr,Node,GroepNr,3)
 Set MaxDat=$$INTDATE^vhDTyp(BonDat),MinDat=MaxDat-1
 Set BONNr=""
 For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do  Quit:'Beperk
 .Set Node=$$NODE(BONNr),R=^KUL(KLNr,Node,BONNr,1),BonDat=$$INTDATE^vhDTyp($P(R,D,2))
 .If BonDat'<MinDat,BonDat'>MaxDat Quit
 Set:'Beperk MinDat=$$CALCDATE^vhDTyp(MaxDat,"W",-1,"FD"),MaxDat=$$CALCDATE^vhDTyp(MaxDat,"W","LD")
 Set Count=0
 For Node=$S('Beperk:"G",1:""),"F" Do:$L(Node)
 .Set BONNr=""
 .For  Set BONNr=$O(^KUL(KLNr,Node,BONNr)) Quit:BONNr=""  Do
 ..If Beperk,'$D(BONNrs(BONNr)),$P(^KUL(KLNr,Node,BONNr,3),D,2,9)'=$P(LevAdr,D,2,9) Quit
 ..Set R=^KUL(KLNr,Node,BONNr,1)
 ..Quit:$P(R,D,18)'=RefMunt
 ..Set BonDat=$$INTDATE^vhDTyp($P(R,D,2))
 ..If $L($P(R,D,8)),$P($P(R,D,8),";",2)'=GroepNr Quit
 ..Set VerzW=$P(R,D,7),VervRef=$P($P(R,D,8),";"),BonStat=$P(R,D,28)
 ..If '$D(BONNrs(BONNr)) Quit:BonDat<MinDat  Quit:BonDat>MaxDat
 ..Set Selected=''$D(BONNrs(BONNr)) Set:'Selected Selected=$P($P(R,D,8),";",2)=GroepNr
 ..Set IsHalux=$$ISHALUX^FLOW("L",BONNr)
 ..Set R=BONNr_D_Selected_D_$S(BONNr=GroepNr:VervRef,1:"")_D_$S(BONNr=GroepNr:GroepNr,1:"")
 ..Set R=R_D_BonDat_D_VerzW_D_BonStat_D_IsHalux
 ..Set Count=Count+1,BonList(Count)=R
 Quit
 
fetchbon(RefBonNr,VarRef,BonList) 
 New R,BONNr,KLNr,BonDat,MinDat,MaxDat,LevAdr,Count,Selected,VervRef,GroepNr,VerzW,BonStat,IsHalux,Node,Beperk,RefMunt
 Set Beperk='$D(@VarRef@("ALL"))
 Set KLNr=$P(^KU1(RefBonNr,"F"),D),Node=$$NODE(RefBonNr)
 Set R=^KUL(KLNr,Node,RefBonNr,1),BonDat=$P(R,D,2),RefMunt=$P(R,D,18),LevAdr=^KUL(KLNr,Node,RefBonNr,3)
 Set MaxDat=$$INTDATE^vhDTyp(BonDat),MinDat=MaxDat-1
 Set BONNr=""
 For  Set BONNr=$O(@VarRef@("BON",BONNr)) Quit:BONNr=""  Do  Quit:'Beperk
 .Set Node=$$NODE(BONNr),R=^KUL(KLNr,Node,BONNr,1),BonDat=$$INTDATE^vhDTyp($P(R,D,2))
 .If BonDat'<MinDat,BonDat'>MaxDat Quit
 .Set @VarRef@("ALL")=1,Beperk=0
 Set:'Beperk MinDat=$$CALCDATE^vhDTyp(MaxDat,"W",-1,"FD"),MaxDat=$$CALCDATE^vhDTyp(MaxDat,"W","LD")
 Set Count=0
 For Node=$S('Beperk:"G",1:""),"F" Do:$L(Node)
 .Set BONNr=""
 .For  Set BONNr=$O(^KUL(KLNr,Node,BONNr)) Quit:BONNr=""  Do
 ..If Beperk,'$D(@VarRef@("BON",BONNr)),$P(^KUL(KLNr,Node,BONNr,3),D,2,9)'=$P(LevAdr,D,2,9) Quit
 ..Set R=^KUL(KLNr,Node,BONNr,1)
 ..Quit:$P(R,D,18)'=RefMunt
 ..Set BonDat=$$INTDATE^vhDTyp($P(R,D,2))
 ..If $L($P(R,D,8)),$P($P(R,D,8),";",2)'=RefBonNr Quit
 ..Set VerzW=$P(R,D,7),VervRef=$P($P(R,D,8),";"),GroepNr=$P($P(R,D,8),";",2),BonStat=$P(R,D,28)
 ..If '$D(@VarRef@("BON",BONNr)) Quit:BonDat<MinDat  Quit:BonDat>MaxDat
 ..Set:BONNr=RefBonNr GroepNr=RefBonNr
 ..Set Selected=''$D(@VarRef@("BON",BONNr))
 ..Set IsHalux=$$ISHALUX^FLOW("L",BONNr)
 ..Set Count=Count+1,BonList(Count)=BONNr_D_Selected_D_VervRef_D_GroepNr_D_BonDat_D_VerzW_D_BonStat_D_IsHalux
 Quit
 ;
MODBONS 
 New R,BONNr,Count,Rembours,Gewicht,TempBons
 Merge TempBons=Bons
 Do SELBON(GroepNr,.BONNrs)
 Do:$D(BONNrs)
 .Do CHKVERZW(.BONNrs)
 .Set BONNr="",Count=0
 .For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do
 ..Set Count=Count+1,$P(ColList(Count),D)=BONNr
 .For Count=Count+1:1 Quit:'$D(ColList(Count))  Do
 ..Set R=ColList(Count),$P(R,D)=""
 ..If $TR(R,D,"")="" Kill ColList(Count)
 ..Else  Set ColList(Count)=R
 .Set (BONNr,Rembours,Gewicht)=""
 .For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do
 ..Set Node=$$NODE(BONNr)
 ..Set Rembours=Rembours+$S($$ISREMB^REMBOURS(KLNr,BONNr):$P($$BON^REMBOURS(BONNr),D),1:"")
 ..Set R=^KUL(KLNr,Node,BONNr,1),Gewicht=Gewicht+$J($P($P(R,D,13),"#",3),0,1)
 .Set:$P(sFL(1),D,2,3)'=(Rembours_D_Gewicht) %SC=1
 .Set $P(sFL(1),D,2,3)=Rembours_D_Gewicht
 .If '%SC Set BONNr="" For  Set BONNr=$O(Bons("BON",BONNr)) Quit:BONNr=""  If '$D(TempBons(BONNr)) Set %SC=1 Quit
 .If '%SC Set BONNr="" For  Set BONNr=$O(TempBons("BON",BONNr)) Quit:BONNr=""  If '$D(BONNrs(BONNr)) Set %SC=1 Quit
 .Set Collie("MAX")=$O(ColList(""),-1)
 .If Collie("SELECT")>Collie("MAX") Set Collie("SELECT")=Collie("MAX") Kill Collie("OFFSET")
 .Do WRITE^vhLIST(.Collie),DISPVAL^vhScherm("NETGEW"),DISPVAL^vhScherm("REMBOURS")
 Kill Bons("ANUL")
 Quit
 ;
CHKMENU(Menu,Type,Aktie) 
 New R,Ok,VervRef,GroepNr,TranspNr,Items,Status,Ophalen,Transfer
 Set Ok=1
 If Menu="CLOSE" Do
 .Set R=$G(^HULP(%J,SelClose("SELECT")))
 .If R="" Set Ok=0 Quit
 .Set VervRef=$P(R,D,21),R=^TRANSP("D",VervRef),Ophalen=$P(R,D,11),Transfer=$P(R,D,12)
 .Set R=$G(^HULP(%J,SelClose("SELECT")))
 .If Type="M",'$G(Beperk) Quit
 .If $P(R,D,24)="K" Do  Quit
 ..Set VervRef=$P(R,D,21),GroepNr=$P(R,D,22)
 ..If Aktie="EP",'$$ISPRINT^TRANSPL(VervRef,GroepNr) Quit
 ..If Aktie="ER",$$ISPRINT^TRANSPL(VervRef,GroepNr) Quit
 ..Set Ok=0
 .If Type'="M",Ophalen,Transfer,Aktie'="VR",Aktie'="RS" Set:Aktie'["DELETE" Ok=0 Quit
 .If "\EDIT\ENTER\"[(D_Aktie_D) Do
 ..If '$$CHKMENU(Menu,Type,"O"),'$$CHKMENU(Menu,Type,"T") Set Ok=0
 .Else  Do
 ..Set VervRef=$P(R,D,21),TranspNr=$P(R,D),Status=$P(R,D,2),R=$G(^TRANSP("T",TranspNr)),Items=$P(R,D,4)
 ..If Type="F",Status="T",Aktie="VR" Quit  ; Herprint vervoerlijst
 ..If Type="F",Status="T",Aktie="RS" Quit  ; Herzenden vervoerlijst
 ..Set:Items="" Items="O#T#E" Set Items="#"_Items_"#"
 ..Set:Ophalen Items=$P(Items,"O#")_$P(Items,"O#",2) Set:Transfer Items=$P(Items,"T#")_$P(Items,"T#",2)
 ..If Items[("#"_Aktie_"#") Quit:Aktie'="E"  Quit:'$$ISPRINT^TRANSPL(VervRef)
 ..Set Ok=0
 Quit Ok
 ;
SELVERV(TrpNrLim,Optie) 
 New R,VervRef,SelVerv,VervList,Count,Status,Gewicht,KreaDat,Input,Verpak,ColTyp,Node
 Set TrpNrLim=$G(TrpNrLim),Optie=$G(Optie),Node=$S(Optie["A":"D",1:"IO")
 Set VervRef="",Count=0,Input="N"
 For  Set VervRef=$O(^TRANSP(Node,VervRef)) Quit:VervRef=""  Do
 .Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D),Status=$P(R,D,2),Gewicht=$P(R,D,3),KreaDat=$P(R,D,10)
 .If Optie["N" Quit:$P(R,D,11)  Quit:$P(R,D,12)
 .Set (ColTyp,Verpak)=""
 .For  Set ColTyp=$O(^TRANSP("D",VervRef,"Q",ColTyp)) Quit:ColTyp=""  Do
 ..Set R=^TRANSP("D",VervRef,"Q",ColTyp)
 ..Set Verpak($P(^RES("EWBON","PI","COLLIETYPE","D",ColTyp),"`"))=ColTyp_"-"_$P(R,D)
 .Set (ColTyp,Verpak)=""
 .For  Set ColTyp=$O(Verpak(ColTyp)) Quit:ColTyp=""  Set Verpak=Verpak_";"_Verpak(ColTyp)
 .Set $E(Verpak)=""
 .Set R=VervRef_D_TranspNr_D_KreaDat_D_Status_D_Verpak_D_Gewicht
 .Set Count=Count+1,VervList(Count)=R
 Do:Count
 .Do STORE^vhTERMINA()
 .Do INIT^vhLIST("TRANSP","SELVERV",.SelVerv)
 .Set:Optie'["N" $P(SelVerv("B",3),"`",3)="H"
 .Do WRITE^vhLIST(.SelVerv)
 .For  Set Input=$$SCROLL^vhLIST(.SelVerv) Quit:Input="A"  Quit:Input="N"  Do  Quit
 ..Set R=VervList(SelVerv("SELECT")),VervRef=$P(R,D),TranspNr=$P(R,D,2)
 .Do REFRESH^vhTERMINA()
 Set:Input="N" R=$$NEWVERV(TrpNrLim),TranspNr=$P(R,";"),VervRef=$P(R,";",2)
 Set R=$G(VervRef) Set:R R=TranspNr_";"_R
 Quit R
 ;
NEWVERV(TranspNr) 
 New R,VervRef
 Set TranspNr=$G(TranspNr) Set:'TranspNr TranspNr=$$TRANSP^LEVER(,5036)
 Do:TranspNr
 .Lock +^TRANSP("N")
 .Set VervRef=$G(^TRANSP("N"))+1,^TRANSP("N")=VervRef
 .Lock -^TRANSP("N")
 Set R=$G(VervRef) Set:R R=TranspNr_";"_R
 Quit R
 ;
DELVERV(VervRef) 
 New GroepNr
 Set GroepNr=""
 For  Set GroepNr=$O(^TRANSP("D",VervRef,"D",GroepNr)) Quit:GroepNr=""  Do DELGRP(VervRef,GroepNr)
 Quit
 ;
CUMVERV(VervRef) 
 New R,GroepNr,ColList,ColTyp,Gewicht
 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),ColTyp=""
 .For  Set ColTyp=$O(^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp)) Quit:ColTyp=""  Do
 ..Set R=^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp),Aantal=$P(R,D)
 ..Set ColList(ColTyp)=$G(ColList(ColTyp))+Aantal
 Kill ^TRANSP("D",VervRef,"Q")
 Set ColTyp=""
 For  Set ColTyp=$O(ColList(ColTyp)) Quit:ColTyp=""  Set:ColList(ColTyp) ^TRANSP("D",VervRef,"Q",ColTyp)=ColList(ColTyp)
 Set R=^TRANSP("D",VervRef) Set:'$P(R,D,4) $P(R,D,3)=Gewicht,^TRANSP("D",VervRef)=R
 Quit
 ;
COLLIST() 
 New ColTemp
 Merge ColTemp=Collie
 New Collie
 Merge Collie=ColTemp
 Set $P(Collie("SET"),"`",7)=""
 Set Collie("SELECT")=""
 Do WRITE^vhLIST(.Collie)
 Write @FMTCL
 Quit ""
 ;
COLEDIT() 
 New R,Input
 Do WRITE^vhLIST(.Collie)
 Set FP=2201
 Write @F,@F1
 For  Do  Quit:Input="CANC"
 .Set Input=$$SCROLL^vhLIST(.Collie)
 .Do:Input="COM" CALL^vhMenu("TRANSPCOL")
 .Do EXEC^vhMenu("TRANSPCOL",.Input)
 Quit Input
 ;
COLITEM(ColList,Collie,Modify) 
 New R,sFL
 Set Modify=$G(Modify,"AE")
 Set sFL(1)=ColList(Collie("SELECT")) Set:$P(sFL(1),D,2)'="L" Modify="A"
 If $L(Modify)=1 Do
 .Do STORE^vhTERMINA()
 .Do FIELD^vhScherm("TRANSPCOL",$S(Modify="A":"AANTAL",1:"EXTRA"))
 .Do REFRESH^vhTERMINA()
 Else  Do:$L(Modify)
 .If $P(sFL(1),D,4),$P(sFL(1),D,5) Do EDIT^vhScherm("TRANSPCOL","","","","","",3) Quit
 .Do NIEUW^vhScherm("TRANSPCOL","","","","","",3)
 If %SC Set ColList(Collie("SELECT"))=sFL(1) Do REFRESH^vhLIST(.Collie,"L",Collie("SELECT"))
 Quit
 ;
COLIAANT(VervRef,GroepNr) 
 New R,Colli,ColTyp,TranspNr
 Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D)
 If TranspNr=5036 Do
 .Set Colli=0,ColTyp=""
 .For  Set ColTyp=$O(^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp)) Quit:ColTyp=""  Do
 ..Set Colli=Colli+^TRANSP("D",VervRef,"D",GroepNr,"Q",ColTyp)
 .Set:'Colli Colli=""
 Else  Set Colli="Grp"
 Quit Colli
 ;
COLRPL() 
 New R,ColTemp
 Merge ColTemp=Collie
 New Collie
 Merge Collie=ColTemp
 Set $P(Collie("SET"),"`",7)=""
 Set Collie("SELECT")=""
 For  Set R=$$SCROLL^vhLIST(.Collie) Quit:R="ENTER"
 Quit ""
 ;
NODE(BONNr) 
 New KLNr,Node
 Set KLNr=$P(^KU1(BONNr,"F"),D)
 For Node="F","G","M" Quit:$D(^KUL(KLNr,Node,BONNr))
 Quit Node
 ;
GETREFS(BONNr) 
 New R,KLNr,Node
 Set R=$G(^KU1(BONNr,"F"))
 Set:$L(R) KLNr=$P(R,D),Node=$$NODE(BONNr),R=$G(^KUL(KLNr,Node,BONNr,1))
 Quit $P(R,D,8)
 ;
BON(BONNr) 
 New R,VervRef,GroepNr
 Set R=$$GETREFS(BONNr),VervRef=$P(R,";"),GroepNr=$P(R,";",2)
 Do RPLGRP(VervRef,GroepNr)
 Quit
 ;
BONEDIT() 
 New R,Input,Temp,BONNr
 Merge Temp=BONNrs
 Do SELBON(Adres,.BONNrs)
 Do:'%SC
 .Set BONNr=""
 .For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  If '$D(Temp(BONNr)) Set %SC=1 Quit
 .Quit:%SC
 .For  Set BONNr=$O(Temp(BONNr)) Quit:BONNr=""  If '$D(BONNrs(BONNr)) Set %SC=1 Quit
 Do:%SC
 .Set BONNr=""
 .For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do ##Class(BL.Flow.Cons.TransportFlow).VerzendWijze(GroepNr,BONNr)
 Quit ""
 ;
LOCK(VervRef,GroepNr) 
 New %TC,Ref,TranspNr
 Set Ref="^TRANSP(""D"",VervRef" Set:$L($G(GroepNr)) Ref=Ref_",""D"","_GroepNr Set Ref=Ref_")"
 Do ADD^vhLock($NA(@Ref))
 Do:'%TC
 .Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D)
 .Do LDISP^vhLock($NA(@Ref),"Vervoer "_VervRef_" van "_TranspNr_" "_$P(^KLE(^KL1(TranspNr),0),D,2))
 Quit %TC
 ;
UNLOCK(VervRef,GroepNr) 
 New Ref
 Set Ref="^TRANSP(""D"",VervRef" Set:$L($G(GroepNr)) Ref=Ref_",""D"","_GroepNr Set Ref=Ref_")"
 Do REMOVE^vhLock($NA(@Ref))
 Quit
 ;
CHECKALL(VerzW) 
 New %J,R,CheckAll,KLNr,KlantInd,BONNr,Bons,Count,KlRec,BonRec,List,Input
 Do STORE^vhTERMINA()
 Set FP=245
 Write @F,$J("",15),@FMTK,"*** I'm thinking ***",@FMTk
 Set %J=$$%J^vhRtn1()
 Kill ^HULP(%J)
 Set KLNr=0
 For  Set KLNr=$O(^KUL(KLNr)) Quit:KLNr=""  Do
 .Set KlantInd=^KK1(KLNr),BONNr=""
 .For  Set BONNr=$O(^KUL(KLNr,"F",BONNr)) Quit:BONNr=""  Do
 ..Set R=^KUL(KLNr,"F",BONNr,1)
 ..Quit:$L($P(R,D,8))  Quit:$E($P($P(R,D,7),"#"),1,$L(VerzW))'=VerzW
 ..Set Bons(KlantInd,BONNr)=""
 Set KlantInd="",Count=0
 For  Set KlantInd=$O(Bons(KlantInd)) Quit:KlantInd=""  Do
 .Set KlRec=^KKL(KlantInd,0),KLNr=$P(KlRec,D),BONNr=""
 .For  Set BONNr=$O(Bons(KlantInd,BONNr)) Quit:BONNr=""  Do
 ..Set BonRec=^KUL(KLNr,"F",BONNr,1)
 ..Set R=BONNr_D_$P(BonRec,D,28)_D_KLNr_D_$P(KlRec,D,2)_D
 ..Set:$$LAND^vhRtn1($P(KlRec,D,8))'="BE" R=R_$$LAND^vhRtn1($P(KlRec,D,8))_"-"
 ..Set R=R_$P(KlRec,D,7)_D_BonRec
 ..Set Count=Count+1,^HULP(%J,"D",Count)=R
 Do REFRESH^vhTERMINA()
 Do:$D(^HULP(%J))
 .Do STORE^vhTERMINA()
 .Do INIT^vhLIST("TRANSP","NOVERV",.List)
 .Do WRITE^vhLIST(.List)
 .For  Set Input=$$SCROLL^vhLIST(.List) Quit:Input="O"!(Input="A")  Do
 ..Set R=^HULP(%J,"D",List("SELECT")),BONNr=$P(R,D)
 ..Do VERWERK^TRANSP(BONNr),LINE^vhLIST(.List,List("SELECT"))
 .Set CheckAll=Input="O"
 .Kill ^HULP(%J)
 .Do REFRESH^vhTERMINA()
 Quit $G(CheckAll,1)
 ;
CHKVERZW(BONNrs) 
 New R,BonRec,KLNr,Taal,BONNr,OldVerzW,NewVerzW
 Set BONNr=""
 For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Do
 .If '$G(KLNr) Do
 ..Set KLNr=$P(^KU1(BONNr,"F"),D),R=^KKL(^KK1(KLNr),0)
 ..Set Taal=$P(R,D,9) Set:Taal="" Taal="N"
 ..Set NewVerzW="SP",NewVerzW=NewVerzW_" #"_^RES("KLANT","PI","VERZENDWIJZE","D",NewVerzW,Taal)
 .Set BonRec=^KUL(KLNr,"F",BONNr,1),OldVerzW=$P(BonRec,D,7)
 .Quit:$E(OldVerzW,1,2)=$E(NewVerzW,1,2)
 .Set R=$$^vhTXTPOP("TRANSP","NOABX","",BONNr,$TR(OldVerzW,"#",""),$TR(NewVerzW,"#",""))
 .Do KILL^KFVZW("F",BonRec,BONNr)
 .Set $P(BonRec,D,7)=NewVerzW,^KUL(KLNr,"F",BONNr,1)=BonRec
 .Do SET^KFVZW("F",BonRec,BONNr)
 Quit
 ;
CHKCOL(ColList) 
 New NextCol,Ok
 Set Ok=0,NextCol=""
 For  Set NextCol=$O(ColList(NextCol)) Quit:NextCol=""  Set Ok=$P(ColList(NextCol),D,4) Quit:Ok
 Quit Ok
 ;
ASKOPN(GroepNr,R) 
 New Txt,But
 Set Txt(1)="Er zijn geen aantallen ingevuld!"
 Set Txt(2)="Wenst u levernr "_GroepNr_" in het transport op te nemen?"
 Set Txt(3)="Indien ""Ja"", dan moet u aantallen ingeven."
 If $P(sFL(1),D,2) Do
 .Set Txt(4)="ŞBAandacht!!!Şb"
 .Set Txt(5)="ŞBRembours: "_$$EXTNUM^vhDTyp($P(sFL(1),D,2),0,".",$$MUNT^vhRtn1($$BONMUNT^TRANSP(GroepNr),4))
 .Set Txt(5)=Txt(5)_" "_$$MUNT^vhRtn1($$BONMUNT^TRANSP(GroepNr),1)_"Şb"
 Set But(1)="Ja&1",But(2)="Neen"
 Quit $$WILD^vhTXTPOP("C;C","","Txt","But",2)
 ;
BCSTAT(Screen) 
 New R,BarCode,VervRef,GroepNr,KLNr,KlNaam
 Do:$D(Screen) DISPLAY^vhScherm(Screen)
 For  Do  Quit:BarCode="-"
 .Do STORE^vhTERMINA()
 .Set BarCode=$$BCSELECT($G(BarCode))
 .Do REFRESH^vhTERMINA()
 .Do:BarCode
 ..Set R=$G(^TRANSP("L",BarCode_" ")),VervRef=$P(R,D,2),GroepNr=$P(R,D,3)
 ..If VervRef,GroepNr Do
 ...If '$D(^TRANSP("D",VervRef,"D",GroepNr,"C",BarCode)) Do              
 ....Set KLNr=$P(^KU1(GroepNr,"F"),D),R=^KKL(^KK1(KLNr),0),KlNaam=$P(R,D,2),R=KLNr_" "_KlNaam
 ....Set R=$$^vhTXTPOP("TRANSP","BCDELETED","",BarCode,VervRef,GroepNr,R)  
 ...Else  Do RPLGRP(VervRef,GroepNr)
 ..Else  Set R=$$^vhTXTPOP("TRANSP","BCUNDEF","",BarCode)
 Quit
 ;
BCSELECT(BarCode) 
 New R,X,Y,GroepNr,KLNr
 Set BarCode=$$ASK^vhINP("Barcode : ",14,BarCode)
 If BarCode,'$D(^TRANSP("L",BarCode_" ")) Do
 .Set Y(0)=0,R=$O(^TRANSP("L",BarCode_" "),-1)
 .For  Set R=$O(^TRANSP("L",R)) Quit:$E(R,1,$L(BarCode))'=BarCode  Do
 ..Set X=^TRANSP("L",R),GroepNr=$P(X,D,3),KLNr=$P(^KU1(GroepNr,"F"),D)
 ..Set Y(0)=Y(0)+1,Y(Y(0))=R_D_X_D_KLNr
 .If 'Y(0) Quit
 .If Y(0)=1 Set X=1
 .Else  Do
 ..Set Y="22\\Selekteer een barcode\\\TRANSPBC"
 ..Kill X
 ..Do ^POP
 .Set BarCode=$S(X:$TR($P(Y(X),D)," ",""),1:"")
 Quit BarCode
 ;
BONMUNT(BONNr) 
 New R,KLNr,Node,Munt
 Set KLNr=$P(^KU1(BONNr,"F"),D),Node=$$NODE(BONNr)
 Set R=^KUL(KLNr,Node,BONNr,1),Munt=$P(R,D,18)
 Quit Munt
 ;
RUBREXEC
 If X="-",TranspNr=5036 Do  ; Indien ABX
 .Quit:$$CHKCOL(.ColList)
 .If $$ASKOPN(GroepNr,.sFL) S X="" Quit
 .Do:sModT="E"  ; Verwijder groep indien geen collies ingevuld
 ..New BONNr
 ..Set BONNr=""
 ..For  Set BONNr=$O(^TRANSP("D",VervRef,"D",GroepNr,"B",BONNr)) Quit:BONNr=""  Do
 ...Do:BONNr'=GroepNr ##Class(BL.Flow.Cons.TransportData).DeleteLevering(BONNr, VervRef, GroepNr)
 ..Do ##Class(BL.Flow.Cons.TransportData).DeleteLevering(GroepNr, VervRef, GroepNr)
 .Set %SC=0
 If X="O",TranspNr'=5036 Do  ; Wijzigen algemene opmerking
 . New X
 . Do FIELDI^vhScherm("ALGOPMERK")
 Quit
 ;
INITEXEC
 Do:$G(Ophalen)!$G(Transfer) REMATTR^vhScherm("OPHALEN","H","H"),REMATTR^vhScherm("TRANSFERT","H","H")
 Do:TranspNr=5036 REMATTR^vhScherm("COLLIST","HD","HD")
 Do:TranspNr'=5036 REMATTR^vhScherm("ALGOPMERK","H","H"),REMATTR^vhScherm("LEVBONS","HD","HD"),REMATTR^vhScherm("OPMERKING","HD","HD")
 Quit
 ;
LENLANGG(X) 
 New I,sEr,MaxLen
 Set sEr="",MaxLen=6
 For I=1:1:$L(X,"+") Do  Quit:$L(sEr)
 .If $P(X,"+",I)'?.N Set sEr="Foutieve numerieke ingave"
 .Else  If $P(X,"+",I)'>0&$P(sFL(1),D,4) Set sEr="Moet groter zijn dan nul"
 .Else  If $P(X,"+",I)>MaxLen Set sEr="Maximum "_MaxLen_" meter"
 Quit sEr
 ;
TRANSPORTEUR(VervRef)
 New Obj,Transporteur
 Set Obj=##Class(Flow.Cons.Transport).%OpenId(VervRef)
 Set:$IsObject(Obj) Transporteur=Obj.Transporteur
 Quit $G(Transporteur)
 ;
BONLIST()
 New BonList,BONNr
 Set (BonList,BONNr)=""
 For  Set BONNr=$O(BONNrs(BONNr)) Quit:BONNr=""  Set BonList=BonList_", "_BONNr
 Set $E(BonList)=""
 Quit BonList
 ;