PVHAFELE ;software specifiek voor Haefele [ 10/30/2001  4:38 PM ]
#include %Prod.Product
#define KLNr 2671
 	; De producten in een excel van Haefele trachten te kopellen aan intern productnr
	;Key is opgebouwd uit IDNr_Spatie_KortTekst_$_KlantRef
GetPRNr(Key)
 	Set D="\",Q="K",U=";"
	Set KLNr=$$$KLNr ; haefele Ned
	Set EindMnd=$$CALCDATE^vhDTyp($H,"M",-1)
	Set BeginMnd=$$CALCDATE^vhDTyp(EindMnd,"M",-11)
	Set EindMnd=$$EXTDATE^vhDTyp(EindMnd,"DM4")_" "
	Set BeginMnd=$$EXTDATE^vhDTyp(BeginMnd,"DM4")_" "
	
	Set IDKey=$P($P(Key,"$")," ")
	Set KTKey=$P($P(Key,"$")," ",2,99)
	Set KLRef=$P(Key,"$",2)
	Set ResPRNr=""
	
	If $TR(KLRef," ")'="" Do ; Klant referentie
	. Kill Res
	. Set KLRef2=$$UPTRIMAN^vhRtn1(KLRef)
	. Quit:KLRef2=""
	. Quit:'$D(^PAKKET("IK",KLNr,KLRef2))
	. Set PAKNr=^PAKKET("IK",KLNr,KLRef2)
	. Set PRNr=""
	. For  Set PRNr=$O(^PAKKET("D",PAKNr,PRNr)) Quit:PRNr=""  Do
	. . Set Res(PRNr)=""
	. . Set Res=$G(Res)+1
	. Set SortKey="",PRNr=""
	. For  Set PRNr=$O(Res(PRNr)) Quit:PRNr=""  Do
	. . If Res=1 Set ResPRNr=" ; "_PRNr
	. . Else  Set ResPRNr=ResPRNr_" ; "_PRNr_" : "_$P(^KPR(PRNr,0),"\")
	. Set $E(ResPRNr,1,3)=""
	Quit:ResPRNr'="" ResPRNr
	
	If $TR(IDKey," ")'="" Do ; IdentNr
	. Set IDKey2="0"_$TR(IDKey,".","")_" "
	. If $D(^KPR2(IDKey2)) Set ResPRNr=$P(^KPR2(IDKey2),"\") Q
	. Set IDKey2="6"_$TR(IDKey,".","")_" "
	. If $D(^KPR2(IDKey2)) Set ResPRNr=$P(^KPR2(IDKey2),"\") Q
	Quit:ResPRNr'="" ResPRNr
 
 
	If $TR(KTKey," ")'="" Do
	. If $E(KTKey,$L(KTKey)-1,$L(KTKey))="HA" Set $E(KTKey,$L(KTKey)-1,$L(KTKey))=""
	. Set KTKey=$$UPTRIMAN^vhRtn1(KTKey)
	. Set KTStart=$E(KTKey,1,3)
	. Set KTLoop=KTStart_" "
	. Kill Res
	. Set (HasQty,HasStock)=0
	. For  Set KTLoop=$O(^KPR1(KTLoop)) Quit:$E(KTLoop,1,$L(KTStart))'=KTStart  Do
	. . Set KortT=$P(^KPR1(KTLoop),"\",2)
	. . Quit:$E($$UPTRIMAN^vhRtn1(KortT),1,$L(KTKey))'=KTKey
	. . Quit:KortT["*KP*"
	. . Quit:KortT["*DO*"
	. . Quit:KortT?.E1"*"4.5N1"*".E
	. . Set PRNr=$P(^KPR1(KTLoop),"\",1)
	. . Set StatQty=$$PROD^STAT(PRNr,KLNr,BeginMnd,EindMnd,1)
	. . Set:StatQty>0 HasQty=HasQty+1
	. . Set Stock=$$$PRGet($$$StockType)
	. . Set:Stock=1 HasStock=HasStock+1
	. . Set lbVerpak=$$lbVerpak^PRODUKT(PRNr)
	. . Set:lbVerpak="" lbVerpak=$LB(1)
	. . Set SortKey=Stock+$LG(lbVerpak,$LL(lbVerpak))
	. . ;w PRNr," ",SortKey," ",KortT,!
	. . Set Res(SortKey,PRNr)=$LB(StatQty,Stock,KortT)
	. . Set Res=$G(Res)+1
	. Set SortKey="",PRNr=""
	. For  Set SortKey=$O(Res(SortKey)) Quit:SortKey=""  Do
	. . For  Set PRNr=$O(Res(SortKey,PRNr)) Quit:PRNr=""  Do
	. . . If HasStock,$LI(Res(SortKey,PRNr),2)'=1 Kill Res(SortKey,PRNr) Set Res=Res-1 q
	. . . If HasQty,$LI(Res(SortKey,PRNr),1)'>0 Kill Res(SortKey,PRNr) Set Res=Res-1 q
	. Set SortKey="",PRNr=""
	. For  Set SortKey=$O(Res(SortKey)) Quit:SortKey=""  Do
	. . For  Set PRNr=$O(Res(SortKey,PRNr)) Quit:PRNr=""  Do
	. . . If Res=1 Set ResPRNr=" ; "_PRNr
	. . . Else  Set ResPRNr=ResPRNr_" ; "_PRNr_" : "_$$ListToPieces^vhLib(Res(SortKey,PRNr))
	. Set $E(ResPRNr,1,3)=""
	. 
	Quit ResPRNr
 
GetVerpak(PRNr)
 	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
 	Set Verpak=$$ListToPieces^vhLib($$lbVerpak^PRODUKT(PRNr),";")
 	Set Stock=$$$PRGet($$$StockType)
 	If Stock Quit Verpak
 	Quit $$$PRGet($$$MinimumBestelHoeveelheid)
 	
GetKortTekst(PRNr)
 	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
 	Quit $$$PRGet($$$KortTekst)
 
GetIdentNr(PRNr)
 	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
 	Quit $$$PRGet($$$IdentNummer)
	 	
GetPrijs(PRNr)
 	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
	Quit $tr($P($$KLANTPR^KPRIJS(KLNr,PRNr,"S"),"\",1),".",",")
	 	
GetGO(PRNr)
 	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
	Quit $S($P($$KLANTPR^KPRIJS(KLNr,PRNr,"S"),"\",3)="H":"%",1:"")
 
GetStock(PRNr)
 	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
 	Set Stock=$$$PRGet($$$StockType)
 	If Stock Quit "Stock"
 	Quit $$$PRGet($$$LeveringsTermijn)+1
 
GetAdviesPrijs(PRNr)
 	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
	Quit $tr($P($$KlantPrijsViaKorting^KPRIJS(KLNr,PRNr,"L","",,1,"S"),"\",1),".",",")
	 	
GetSN(PRNr)
	Quit:PRNr="" ""
	If PRNr'?4.7N Set PRNr=$P(^KPR2($TR(PRNr,". ","")_" "),"\")
	Quit:PRNr'?4.7N ""
 	Quit:'$D(^KPR(PRNr)) ""
 	Set Stock=$$$PRGet($$$StockType)
 	If Stock Quit "S"
 	Quit "N"
 
 
 Kill  Do INIT^vhTERMINA
 Set String="INTERIEUR ARCHITECTUUR;INTERIEURBOUW;MEUB. MAKER;MEUBELFABRIEK;PROJEKT MEUBELEN;PROJECT MEUBELEN;MEUBELATELIER;INSTALLATIEBEDRIJF;MEUBELMAKERIJ;BOUWBEDRIJF;INTERIEURBOUWER;MEUBELEN;INTERIEUR;BETIMMERING"
 Set String=String_";BETIMMERINGEN;JACHTBOUW;HOUTIMPORT;KOELMEUBELEN;TIMMERWERKEN;IJZERWARENHANDEL;AANNEMERSBEDRIJF;MEUBELMAKERSBEDRIJF;WINKELINRICHTING;INTERIEURBEDRIJF;CARROSSERIEBEDRIJF"
 Set String=String_";TIMMERFABRIEK;TIMMERBEDRIJF;YACHTINTERIORS;HOUTV. INDUSTRIE"
 For I=1:1:$L(String,";") Set AanChk($L($P(String,";",I)),$P(String,";",I))=""
 Set VolgNr=""
 For  Set VolgNr=$O(^PVHAFELE(VolgNr))  Q:VolgNr=""  Do
 .Do ONE(^PVHAFELE(VolgNr))
 Quit
 
ONE(Rec) 
 Set HafKLNr=$$TRIML($P(Rec,D,1))
 Set KlantRec=$$SPLITNM($P(Rec,D,2))
 Set KlantNm=$P(KlantRec,D,1)
 Set Toenaam=$P(KlantRec,D,2)
 Set Aanspr=$P(KlantRec,D,3)
 Set PrijsKl=$$PRIJSKL($P(Rec,D,3))
 Set Straat=$$TRIML($P(Rec,D,4))
 Set Tel=$$TEL($P(Rec,D,5))
 Set PostNr=$$POSTK($P(Rec,D,6))
 Set Gem=$$TRIML($P(Rec,D,7))
 Set Fax=$$TEL($P(Rec,D,8))
 Quit:'$$CHECK()
 Do SAVE
 Quit
 
SAVE Set KLNr=$$NEXTID^cw()
 w *7
 Kill B
 Set $P(B(0),D,1)=KLNr
 Set $P(B(0),D,2)=KlantNm
 Set $P(B(0),D,3)=Toenaam
 Set $P(B(0),D,4)=Aanspr
 Set $P(B(0),D,5)=Straat
 Set $P(B(0),D,6)=PostNr
 Set $P(B(0),D,7)=Gem
 Set $P(B(0),D,8)=$$LAND^vhRtn1("NL","I")
 Set $P(B(0),D,9)="N"
 Set $P(B(0),D,13)=Tel
 Set $P(B(0),D,15)=0
 Set $P(B(0),D,20)=4
 Set $P(B(0),D,26)=""
 Set $P(B(0),D,15)=""
 Set $P(B(1),D,4)="HAEFELE klantnr = "_HafKLNr
 Set $P(B(1),D,10)=2671
 Set $P(B(1),D,22)=Fax
 Set $P(B(1),D,25)="D"
 Set $P(B(1),D,26)=""
 Set $P(B(2),D,3)=PrijsKl
 Set $P(B(2),D,26)=""
 Set $P(B(3),D,26)=""
 Set $P(B(4),D,26)=""
 Set $P(B(5),D,26)=""
 Set $P(B(6),D,26)=""
 Set $P(B(7),D,26)=""
 Set $P(B(8),D,26)=""
 Set Key=$$UPTRIMAN^vhRtn1(KlantNm)_" "_KLNr
 Merge ^KKL(Key)=B
 Set ^KK1(KLNr)=Key
 Quit
 
CHECK() 
CHECK2 Write @F11,@F1
 Set Rec=$$TRIML(Rec)
 Write !,"KlantNaam  =",?15,KlantNm,?45,"(",$P(Rec,D,2),")"
 Write !,"Toenaam    =",?15,Toenaam
 Write !,"Aanspreking=",?15,Aanspr
 Write !,"Straat     =",?15,Straat,?45,"(",$P(Rec,D,4),")"
 Write !,"Postkode   =",?15,PostNr,?45,"(",$P(Rec,D,6),")"
 Write !,"Gemeente   =",?15,Gem,?45,"(",$P(Rec,D,7),")"
 Write !,"Telefoon   =",?15,Tel,?45,"(",$P(Rec,D,5),")"
 Write !,"Fax        =",?15,Fax,?45,"(",$P(Rec,D,8),")"
 Write !,"Prijsklasse=",?15,PrijsKl,?45,"(",$P(Rec,D,3),")"
 Set Nm=$$UPTRIMAN^vhRtn1(KlantNm)
 Set Len=$L(Nm),Cnt=0
 Write !,@FMTI
 For  Set Nm=$O(^KKL(Nm)) Quit:$E(Nm,1,Len)'=$$UPTRIMAN^vhRtn1(KlantNm)  Do  ; Display Bestaat reeds
 .Quit:$$LAND^vhRtn1($P(^KKL(Nm,0),D,8))'="NL"
 .Set Cnt=Cnt+1
 .Write !,$P(^KKL(Nm,0),D,1)," ",$P(^KKL(Nm,0),D,2),"  ",$P(^KKL(Nm,0),D,5),"  ",$P(^KKL(Nm,0),D,7)
 Write @FMTi
 Write !,"Bijvoegen (Ja/Nee/Wijzig) ?"
 R *K
 Set K=$C(K)
 If K="W"!(K="w") Do WIJZIG Goto CHECK2
 Set Chk=K="J"!(K="j")
 Quit:'Cnt!'Chk Chk
 Write !,"Bent u zeker dat u wil bijvoegen (Zeker/Nee) ?"
 R *K
 Set K=$C(K)
 Quit K="Z"!(K="z")
 
WIJZIG Do EDIT^vhScherm("PVHAFELE")
 Quit
 
 
SPLITNM(Nm) 
 Set (KlNm,Nm)=$$UPCASE^vhRtn1($$TRIML(Nm))
 Set (Aansp,ToeNm)=""
 If $E(Nm,$L(Nm)-2,$L(Nm))=" BV" Set Aansp="BV",$E(Nm,$L(Nm)-2,$L(Nm))=""
 If $E(Nm,$L(Nm)-6,$L(Nm))=" V.O.F." Set Aansp="v.o.f.",$E(Nm,$L(Nm)-6,$L(Nm))=""
 If $E(Nm,$L(Nm)-3,$L(Nm))=" VOF" Set Aansp="v.o.f.",$E(Nm,$L(Nm)-6,$L(Nm))=""
 If $E(Nm,1,4)="FA. " Set Aansp="Firma",$E(Nm,1,4)=""
 If $E(Nm,1,7)="V.O.F. " Set Aansp="v.o.f.",$E(Nm,1,7)=""
 If $E(Nm,1,4)="VOF " Set Aansp="v.o.f.",$E(Nm,1,4)=""
 If $L(Nm)>3 Set KlNm=Nm 
 Set Len="",Chk=""
 For  Set Len=$O(AanChk(Len),-1)  Quit:Len=""  Do
 .For  Set Chk=$O(AanChk(Len,Chk)) Quit:Chk=""  Do
 ..Quit:Nm'[Chk
 ..If $E(Nm,1,Len+1)=(Chk_" ") Set $E(Nm,1,Len+1)="",ToeNm=Chk
 ..If $E(Nm,$L(Nm)-Len,$L(Nm))=(" "_Chk) Set $E(Nm,$L(Nm)-Len,$L(Nm))="",ToeNm=Chk
 Set Nm=$$TRIML(Nm)
 ;Properen om de voornaam NA de achternaam te plaatsen
 If Nm?1A1"."1" "1A1.E,$L(Nm," ")=2 Do  w *7
 .Set Nm=$E(Nm,4,99)_" "_$E(Nm,1,2)
 If $L(Nm)<3 Set Nm=KlNm ; Als er te weining overblijft dan reset
 
 Quit Nm_D_ToeNm_D_Aansp
 
 
PRIJSKL(PKL) 
 Quit $S(PKL="B3":"B",PKL="B2":"S",PKL="B1":"R",1:"L")
 
TEL(Tel) 
 Set Tel=$$UPCASE^vhRtn1($$TRIML(Tel))
 Set:$E(Tel,1,3)="TEL" $E(Tel,1,3)=""
 Set:$E(Tel,1,3)="FAX" $E(Tel,1,3)=""
 Set:$E(Tel)="." $E(Tel,1)=""
 For  Quit:$E(Tel)'=" "  Set $E(Tel,1)=""
 Set Tel=$TR(Tel,"*","-")
 Set:$E(Tel)="0" Tel="0031-"_$E(Tel,2,99)
 Quit Tel
 
 
POSTK(PostNr) ; Transformatie postnr
 Set PostNr=$$TRIML(PostNr)
 Set:PostNr?4N1" "2A $E(PostNr,5)="-",PostNr="NL-"_PostNr
 Quit PostNr
 
TRIML(Rec) ; Weghalen van de rechts blanko's
 For I=1:1:$L(Rec,D) Do
 .Set Val=$P(Rec,D,I)  
 .For  Quit:$E(Val,$L(Val))'=" "  Set $E(Val,$L(Val))=""
 .Set $P(Rec,D,I)=Val
 Quit Rec