LEVER ;LEVERANCIERS [ 10/27/2003  9:04 PM ]
 d ^cA604
 s r=$$SELECT(0,"","Test : ")
 W !,r," ",$G(^KL1(r)),@F2,!
 q
 ;
SELECT(IsProd,DefL,Titel,LevInp) 
 New X,Y,Tekst,LevNr,Lev,TLev,Count
 Set IsProd=$G(IsProd)
 Set:'$L($G(DefL)) DefL=$G(sRef("LEV"))
 If $L(DefL),'$D(^KL1(DefL)) Set DefL=""
 If DefL,'$$CHECK(DefL,IsProd) Set DefL=""
 If DefL?4N Set DefL=DefL_" "_$P(^KLE(^KL1(DefL),0),D,2)
 If '$L($G(Titel)) Set Titel="Leverancier : "
 Do ADD^vhScherm(21,24)
 Set LevNr=""
SEL2 If $G(LevInp)="" Set Lev=$$ASK^vhINP(Titel,20,DefL,"Ingave leverancier dmv. naam of nummer")
 Else  Set Lev=LevInp Kill LevInp 
 Quit:Lev="-"!(Lev=".") Lev
 Set:Lev?4N1" ".E Lev=$E(Lev,1,4) ;Afkomstig van default
 Set Lev=$$UPTRIMAN^vhRtn1(Lev)
 If Lev=""!zb Do LIST("") Goto SEL2:'LevNr,EXIT
 If Lev?4N,$D(^KL1(Lev)) Set LevNr=Lev Goto SEL2:'$$CHECK(Lev,IsProd),EXIT
 Set TLev=$O(^KLE(Lev))
 If $E(TLev,1,$L(Lev))'=Lev Goto SEL2
 If $E($O(^KLE(TLev)),1,$L(Lev))'=Lev Set LevNr=+^KLE(TLev,0) Goto SEL2:'$$CHECK(LevNr,IsProd),EXIT
 Do LIST(Lev)
 Goto SEL2:'LevNr,SEL2:'$$CHECK(LevNr,IsProd),EXIT
EXIT Quit LevNr
 
CHECK(LevNr,IsProd) 
 Quit:'IsProd 1
 Quit $P(^KLE(^KL1(LevNr),0),D,27) 
 
LIST(Kode) 
 New Y,X
 Set TLev=Lev
 If '$L(Lev)  Set Lev="ZZZZZ"
 Set:'IsProd Y="5\\Selecteer een leverancier\\MORE^LEVER\LEVER"
 Set:IsProd Y="5\\Selecteer een produktleverancier\\MORE^LEVER\LEVER"
 X "Set Y(0)=$$"_$P(Y,"\",5)_"(0,3)"
 Quit:'Y(0)
 Do ^POP
 Set:X LevNr=+^KLE(Y(X),0)
 Quit
MORE(Max,Len,Ref) 
 If Max>200 w *7 Quit Max
 Set Count=0
 If Max,TLev="" Quit Max
 For  Set TLev=$O(^KLE(TLev)) Quit:TLev=""!($E(TLev,1,$L(Lev))'=Lev)  Set:$S('IsProd:1,1:$P(^KLE(TLev,0),D,27)) Count=Count+1,Y(Max+Count)=TLev Quit:Count>Len
 Set:$E(TLev,1,$L(Lev))'=Lev TLev=""
 Quit Max+Count
   
LEVVW(LevVw,Taal) 
 New R,I,Count
 Set R(1)="",Count=0
 If $E(LevVw,$L(LevVw))'=" " Set LevVw=LevVw_" "
 If $D(^KBA(154,LevVw,Taal)) For I=1,2 If $L(^KBA(154,LevVw,Taal,I)) Set Count=Count+1,R(Count)=^KBA(154,LevVw,Taal,I)
 For Count=1,2 If $D(R(Count)) Do
 .If $L($P(R(Count),":",2)) Set R(Count)=$P(R(Count),":",2)
 .For I=1:1 Set R=$E(R(Count)) Quit:"- "'[R!(R="")  Set R(Count)=$E(R(Count),2,99)
 .If R(Count)="" Kill R(Count)
 Quit $S($D(R(1)):R(1),1:"")_$S($D(R(2)):"#"_R(2),1:"")
 ;
BETVW(BetVw,%KontKrt,TKontKrt,Rembours,Taal) 
 New R,BetDagen,DKontKrt,WisAval,Count
 Set Count=1,R(Count)=""
 If BetVw="" Do  Quit R(1)_$S($D(R(2)):"#"_R(2),1:"")_$S($D(R(3)):"#"_R(3),1:"")
 .Set R(Count)=$$TXT("Kontnt")
 .If Rembours Set R(Count)=R(Count)_" ("_$$TXT("Remb")_")"
 .If %KontKrt Set R(Count)=R(Count)_" "_$$TXT("KontPc")_" "_%KontKrt_"% "_$$TXT("KontPc",3)
 Set BetDagen=+BetVw,WisAval=""
 If "\-W\/A\"[(D_$E(BetVw,$L(BetVw)-1,$L(BetVw))_D) Set WisAval=$E(BetVw,$L(BetVw)-1,$L(BetVw))
 Set BetVw=$E(BetVw,$L(BetDagen)+1,$L(BetVw)-$L(WisAval))
 Set DKontKrt=+TKontKrt,TKontKrt=$E(TKontKrt,$L(DKontKrt)+1,$L(TKontKrt))
 If %KontKrt Do  If 'BetDagen Quit R(1)_$S($D(R(2)):"#"_R(2),1:"")_$S($D(R(3)):"#"_R(3),1:"")
 .Set R(Count)=$S(Taal="E":$$TXT("Kortng")_" ",1:"")_%KontKrt_"% "
 .Set R(Count)=R(Count)_$$TXT($S(Taal="E":"Voor",1:"Kortng"))_" "
 .Set R(Count)=R(Count)_DKontKrt_" "_$$TXT("Dag")
 .If DKontKrt'=1 Set R(Count)=R(Count)_$$TXT("Dag",3)
 .Set R(Count)=R(Count)_" "
 .If TKontKrt="D" Set:Taal="E" R(Count)=R(Count)_$$TXT("VanAf")_" " Set R(Count)=R(Count)_$$TXT("FaktDt")
 .Else  Set R(Count)=R(Count)_$$TXT("EndMth")
 .Set Count=Count+1,R(Count)=$$TXT("Netto")_" "_$S(Taal="E":"",1:$$TXT("Netto",3)_" ")
 Set R(Count)=R(Count)_BetDagen_" "
 If BetVw'="M" Do
 .Set R(Count)=R(Count)_$$TXT("Dag") Set:BetDagen'=1 R(Count)=R(Count)_$$TXT("Dag",3)
 .Set:Taal="E" R(Count)=R(Count)_" "_$$TXT("Netto",3)
 Else  Set R(Count)=R(Count)_$$TXT("Maand") Set:BetDagen'=1 R(Count)=R(Count)_$$TXT("Maand",3)
 If "\D\M\"[(D_BetVw_D) Set R(Count)=R(Count)_" "_$$TXT("FaktDt")
 Else  Set R(Count)=R(Count)_" "_$$TXT("EndMth")
 If $L(WisAval) Do
 .Set Count=Count+1
 .Set R(Count)=$$TXT("Wissel")
 .If WisAval="/A" Set R(Count)=R(Count)_" "_$$TXT("Aval")
 Quit R(1)_$S($D(R(2)):"#"_R(2),1:"")_$S($D(R(3)):"#"_R(3),1:"")
 ;
COMPRES(LeverNm,LEVNr) 
 New I,Out
 Set Out="" For I=1:1:$L(LeverNm) If $E(LeverNm,I)'?1P Set Out=Out_$E(LeverNm,I)
 Quit Out_" "_$G(LEVNr)
 ;
TXT(Ref,Piece) 
 If '$D(Piece) Set Piece=2
 Quit $P($P($T(@("T"_Ref)),U,Piece),D,$F("NFDE",Taal)-1)
 ;
RAADPL(LEVNr) 
 New (%ZR,%ZM,Q,QL,QM,QN,QO,QRVG,QT,QTU,QU,QW,QZ,D,DT,TD,DD,DM,DJ,F70,F71,U,boot,cs,master,workst,io,QP,QD,%Q1,LEVNr,Screen,sScr,sProgLog,RK)
 Xecute F71
 Do R^cAN200("LE","LVH","","LVH","S UI1=^KL1(LEVNr)")
 Quit ""
 ;
 ; Selekteer leverancier
KLE(Node) 
 If Node=5 Do  Quit  ; wijzigen en verwijderen leverancier
 .Set K=$$SELECT() Set:K="." K="-"
 .If K'="-" Set (K,I1)=^KL1(K),R=$D(^KLE(K))
 .Set FP=2101 Write @F,@F1 Quit
 Set K="-"
 Quit
 ;
 ; Xexcute bij openen leveranciers
XOPEN   
 S $P(B(3),D,22)=$H
 Q
 ; Xexcute bij wijzigen leveranciers
XWIJZIG 
 S $P(B(3),D,22)=$H
 Q
 ;
 ; HeeftVrv: De transporteur moet openstaande vervoerlijsten hebben
TRANSP(HeeftVrv,DefLev,Titel,ExtraKey,PopPos) 
 New R,zb,LevId,LEVNr,Count,IsTransp,Transp,TranspNr,VervRef
 Set HeeftVrv=$G(HeeftVrv),DefLev=$G(DefLev),Titel=$G(Titel),ExtraKey=$G(ExtraKey),PopPos=$G(PopPos,"C;C")
 Do:HeeftVrv
 .Set VervRef=""
 .For  Set VervRef=$O(^TRANSP("IO",VervRef)) Quit:VervRef=""  Do
 ..Set R=^TRANSP("D",VervRef),TranspNr=$P(R,D),VervRef(TranspNr)=""
 Set LEVNr=0
 For  Set LEVNr=$O(^TRANSP("T",LEVNr)) Quit:LEVNr=""  Do
 .If HeeftVrv,'$D(VervRef(LEVNr)) Quit
 .Set LevId=^KL1(LEVNr),LEVNr(LevId)=LEVNr
 Set (LevId,Count)=0
 For  Set LevId=$O(LEVNr(LevId)) Quit:LevId=""  Do
 .Set R=^KLE(LevId,0),LEVNr=$P(R,D),LevNaam=$P(R,D,2)
 .Set Count=Count+1,Transp(Count)=LEVNr_"`"_LevNaam
 If $L(ExtraKey),Count>1 Do
 .Set:$L(ExtraKey,"#")=1 ExtraKey="#"_ExtraKey
 .Set Count=Count+1,Transp(Count)="&S"
 .Set Count=Count+1,Transp(Count)=$P(ExtraKey,"#")_"`"_$P(ExtraKey,"#",2)
 Set R=$S($D(Transp):$$WILD^vhPOPUP(PopPos,"O1-",Titel,.Transp,DefLev),1:"") Set:$G(zb)="CANC" R=zb
 Quit R
 ;
KLLABEL 
 New LEVNr
 Write @F11,@F1
 Set FP=202
 Write @F,@F4,"LEVERANCIERETIKETTEN ",QN,@F5
 For  Set LEVNr=$$SELECT() Quit:'LEVNr  Do LEV^KLLABEL(LEVNr) Set FP=1301 Write @F,@F1
 Quit
 ;
ValSchaduwDatum(Datum)
 New %TC,%INT,%EXT
 Do:"-"'[$E(Datum) VALDATE^vhLib.DataTypes(Datum,,+$H)
 Quit $G(%TC,1)
 ;
GetSchaduwDatum(LEVNr)
 Quit $P(^KLE(^KL1(LEVNr),2),D,3)
 ;
 ; Ingeven voorkeur documentoutput
ModToelev
 New zb,Toelev
 Set Toelev=$P($G(B(2)),D,19) Set:Toelev="" Toelev="X"
 Set K=$$PI^vhPOPUP("C;C","-DOK1","Toelev","LEVER","TOELEV",Toelev)
 If $L(K) Set:K="P" K=""
 Else  If zb="CANC" Set K="-"
 Set Locals("K")=K
 Quit
 ;
 ; Om vanuit openen, wijzigen leveranciers vanuit ZWinterm bvb onze vhPOPUP op te roepen
 ; UFU = "O" openen
 ;     = "W" wijzigen
 ; A en B doorgegeven als .local
 ; Bindex is de node en $P van de B-local welke moeten gewijzigd worden
 ; Routine is de eigenlijke routine die ^vhPOPUP zal oproepen
ZWINT(UFU,A,B,BIndex,Routine)
 New U1,U2,U7,ATemp,BTemp,Locals
 Merge ATemp=A,BTemp=B,Locals("B")=B,Locals("UFU")=UFU
 New A,B
 Do E^cA612,DO^vhPROGRAM(Routine)
 Do P^cA612(2,1,20,80,1,"","","",$S(UFU="W":"Wijzigen",1:"Openen")_" leveranciers",$S($ZV["MSM":0,1:1),0,7,1,1)
 Merge A=ATemp,B=BTemp
 If $G(BIndex),Locals("K")'="-" Set $P(B(BIndex\100),D,BIndex#100)=Locals("K")
 Do S1^cAN202
 Set K=$G(Locals("K"))
 Quit
 ;
TransPref(LEVNr,Adres)  ; transmissievoorkeur van een leverancier (fax, mail of printer)
 N (LEVNr,D,Voorkeur,Adres)
 S Index=^KL1(LEVNr)
 S Voorkeur=$P(^KLE(Index,1),D,19)
 If Voorkeur=""!(Voorkeur="P") D
 . Set Voorkeur="P",Adres=""
 Else  If Voorkeur="F" Do
 . Set Adres=$$ZoekFaxNr(LEVNr)
 . If Adres="" Set Voorkeur="P"
 . If Adres'="" Set Voorkeur="F"
 Else  If Voorkeur="M" Do
 . Set Adres=$$ZoekMailAdres(LEVNr)
 . If Adres="" Set Voorkeur="P"
 . If Adres'="" Set Voorkeur="M"
 Quit Voorkeur
 
ZoekFaxNr(LEVNr)  ;zoekt het faxnummer
                  ;eerst zoeken bij de contactpersonen 
                  ;eerst type VA, dan VK en dan AB
                  ;als niets bestaat bij de contactpersonen dan wordt het algemene faxnummer genomen
 N (LEVNr,FaxNr,D)
 Set PersNr="",FaxNr=0
 For  Set PersNr=$o(^PERS("L",LEVNr,PersNr)) Quit:PersNr=""  Do
 . Set FaxNr=""
 . Set xPers=^PERS("L",LEVNr,PersNr),Typ=$Piece(xPers,D,5)
 . Quit:Typ'["VA"&(Typ'["VK")&(Typ'["AB")
 . For i=15:1:19 Do
 . . Set Connect=$Piece(xPers,D,i) Quit:$Piece(Connect,";")'="F"  Quit:$P(Connect,";",2)=""
 . . Set FaxNr=$Piece(Connect,";",2)
 . Quit:FaxNr=""
 . For i=1:1:$L(Typ,";") Set Typ1=$Piece(Typ,";"),lst(Typ1,PersNr)=FaxNr
 If $D(lst("VA")) Do
 . Set PersNr=$O(lst("VA","")) Set FaxNr=lst("VA",PersNr)
 Else  If $D(lst("VK")) Do
 . Set PersNr=$O(lst("VK","")) Set FaxNr=lst("VK",PersNr)
 Else  If $D(lst("AB")) Do
 . Set PersNr=$O(lst("AB","")) Set FaxNr=lst("AB",PersNr)
 Else  Set FaxNr=""
 If FaxNr="" Do
 . S Index=^KL1(LEVNr),FaxNr=$P(^KLE(Index,1),D,24)
 Quit FaxNr
 
ZoekMailAdres(LEVNr) ;zoekt het Mailadres
                     ;eerst zoeken bij de contactpersonen 
                     ;eerst type VA, dan VK en dan AB
                     ;als niets bestaat bij de contactpersonen, dan wordt het algemeen mailadres genomen
 N (LEVNr,MailAdres,D,lst)
 k lst
 Set PersNr="",FaxNr=0
 For  Set PersNr=$o(^PERS("L",LEVNr,PersNr)) Quit:PersNr=""  Do
 . Set MailAdres=""
 . Set xPers=^PERS("L",LEVNr,PersNr),Typ=$Piece(xPers,D,5)
 . Quit:Typ'["VA"&(Typ'["VK")&(Typ'["AB")
 . For i=15:1:19 Do
 . . Set Connect=$Piece(xPers,D,i) Quit:$Piece(Connect,";")'="E"  Quit:$P(Connect,";",2)=""
 . . Set MailAdres=$Piece(Connect,";",2)
 . Quit:MailAdres=""
 . For i=1:1:$L(Typ,";") Set Typ1=$Piece(Typ,";"),lst(Typ1,PersNr)=MailAdres
 If $D(lst("VA")) Do
 . Set PersNr=$O(lst("VA","")) Set MailAdres=lst("VA",PersNr)
 Else  If $D(lst("VK")) Do
 . Set PersNr=$O(lst("VK","")) Set MailAdres=lst("VK",PersNr)
 Else  If $D(lst("AB")) Do
 . Set PersNr=$O(lst("AB","")) Set MailAdres=lst("AB",PersNr)
 Else  Set MailAdres=""
 If MailAdres="" Do
 . S Index=^KL1(LEVNr),MailAdres=$P(^KLE(Index,2),D,19)
 Quit MailAdres
 
TKontnt ;Kontant\Au comptant\Barzahlung\Cash
TRemb ;Rembours\Rembours\Rembours\Cash on delivery
TKontPc ;met\avec\mit\with;korting\d'escompte\skonto\discount
TKortng ;korting\d'escompte endeans\skonto\discount
TDag ;dag\jour\tag\day;en\s\en\s
TVoor ;\\\within
TVanAf ;\\\from the
TFaktDt ;faktuurdatum\date de facturation\rechnungsdatum\date of invoice
TEndMth ;einde maand\fin de mois\ende monat\from the end of the month
TNetto ;of\ou\oder\or;netto\net\netto\net
TMaand ;maand\mois\monat\month;en\\e\s
TWissel ;met wissel\par traitre\mit wechel\by bill
TAval ;getekend voor aval\avalisee\avaliert\guaranteed