BLCSBAF ;Automatisch verwerken inkomende fakturen [ 02/21/2002  4:43 PM ]
 ;
 Do INIT,REFRESH
 Set LEVNr=5005 ;$$SELECT^LEVER() Quit:'LEVNr *** Voor andere leveranciers eerst nazien ***
 Do LINIT,RESET^vhScherm,ADD^vhScherm(1,1),COMMAND,CLEAN
 Quit
 ;
VervRef(VervRef)
 New AutoSelect
 Set AutoSelect=1
 Goto BLCSBAF
 ;
INIT 
 Do ADD^vhScherm(1,1),CLEAN
 Set Input="V"
 Quit
 ;
COMMAND 
 For  Do  Quit:Input="-"
 .Do REFRESH
 .If Input="V" Set R=Input
 .Else  Do SL^PROC
 .Set Input=R
 .If Input="COM" Do MENU
 .If Input="HELP" Do HELP
 .If Input="-" Quit
 .If Input="O" Do MARK
 .If Input="F" Do FAKTUUR
 .If Input="X" Do DELETE
 .If Input="V" Do VERVL(LEVNr,$S($G(AutoSelect):VervRef,1:""))
 Quit
 ;
CLEAN 
 Kill HULP
 Do INIT^PROC("BLCSBAF")
 Lock
 Quit
 ;
PRINT
 New BLCSBAFL,I,R,X,DL
 Merge BLCSBAFL=BLCSBAF
 Set BLCSBAFL(1)="HULP"
 Set BLCSBAFL(11)=BLCSBAFL(11)_"\Vervoerlijst : "_$$EXTNUM^vhDTyp(VervRef,0,".",0)
 Set DL(1)="BLCSBAFL"
 Do ^OUTPUT("P","-","S")
 Quit
 ;
REFRESH 
 If sRT=1 Do
 .Write @F11 Write:'$G(LEVNr) @F1
 .Write @FMTI,"Inboeken inkomende fakturen",$S('$G(LEVNr):"",1:" "_$P(^KLE(^KL1(LEVNr),0),D,2)),@FMTi,@F2
 If sRT<3,sRB>1 Set FP=201 Write @F,"Vervoerlijst : ",$$FN^vhRtn2(VervRef,0,0,"T"),@F2
 If sRB>1 Set DL(2)=sRT,DL(3)=sRB Do WL^PROC
 Do RESET^vhScherm
 Quit
 ;
VERVL(LC,VRF)  
 New R,DL
 Set FP=201 Write @F,@F2
 Do:'$G(VRF)
 . Set (R,VRF)=$O(^Verv(LEVNr,"D","")),R=$O(^Verv(LEVNr,"D",R))
 . If R=""
 . Else  Do SELECT^VERVID("",LC,"SO")
 Do ADD^vhScherm(2,24)
 If 'VRF Do  Quit
 .If $G(VervRef),'$D(^Verv(LEVNr,"D",VervRef)) Set Input="-"
 .Else  Set Input=$S($D(HULP):"",1:"-")
 Set R=^Verv(LEVNr,"D",VRF)
 If $P(R,D,7)'=1,$P(R,D,7)'=2,$P(R,D,7)'="R",$P(R,D,7)'="I",$P(R,D,7)'="F" Do  Quit
 . Do TXTL^vhINP("BLCSBAF","VERVL"),RESET^vhScherm
 . Set:$G(AutoSelect) Input="-"
 . Quit:'$$IsGroep^vhUSER(,"ICT")
 . Quit:'$$^vhTXTPOP("BLCSBAF","ICTDELETE","",VRF)
 . Kill ^Verv(LEVNr,"D",VRF),^Verv(LEVNr,"IA",VRF)
 Set Input=""
 Do FETCHVL(VRF)
 Set VervRef=VRF
 Quit
 ;
FETCHVL(VervRef) 
 New R,LevFANr,Count
 Do CLEAN
 If '$$LOCK("^Verv(LEVNr,""D"",VervRef)") Set Input="V" Quit
 Set LevFANr="",Count=0
 For  Set LevFANr=$O(^Verv(LEVNr,"D",VervRef,LevFANr)) Quit:LevFANr=""  Do
 .Set R=^Verv(LEVNr,"D",VervRef,LevFANr)
 .Quit:$P(R,D)'="01"  ; Enkel de facturen verwerken CW 04.07.08 ;.If $P(R,D)'="01" Set $P(R,D,8)=1,^Verv(LEVNr,"D",VervRef,LevFANr)=R
 .If '$$CHKMUNT(LEVNr,LevMunt,$P(R,D,4)) Set $P(R,D,8)=1,^Verv(LEVNr,"D",VervRef,LevFANr)=R
 .Set Count=Count+1,HULP(Count)=LevFANr
 Quit
 ;
MARK 
 New Rec,LevFANr
 Quit:'$D(HULP)
 Set LevFANr=HULP(@DL(1)@(6))
 Set Rec=^Verv(LEVNr,"D",VervRef,LevFANr)
 If $P(^Verv(LEVNr,"D",VervRef),D,15)'="SO" Write *7 Quit  ; Alleen STANDARD ORDER
 If $P(Rec,D,8)>1!($P(Rec,D,9)) Quit
 If $P(Rec,D)'="01" Do
 .Do TXTL^vhINP("BLCSBAF","MARK")
 Else  If '$$CHKMUNT(LEVNr,LevMunt,$P(Rec,D,4)) Do
 .Do TXTL^vhINP("BLCSBAF","MUNT")
 Else  Set $P(Rec,D,8)='$P(Rec,D,8),^Verv(LEVNr,"D",VervRef,LevFANr)=Rec
 Do EL^PROC
 Quit
 ;
LINIT 
 New R
 Set R=^KLE(^KL1(LEVNr),0),LevMunt=$P(R,D,11),BetVw=$P(R,D,18)
 Quit
 ;
FINIT() 
 New %SC,R,X
 Set FaktDat=$$FAKTDAT(),BtwKode=$$BTWKODE(),%KKort=$$KKORT(LEVNr)
 Do BOEKPER(DM)
 Quit:'OK 0
 Do VERVDAT(FaktDat),MPAR(LevMunt,BJ)
 For  Do EDIT^vhScherm("BLCSBAF") Set R=$S('%SC:"",1:$$ASKL^vhINP("BLCSBAF","FINIT")) Quit:R'="W"
 Set FP=2201 Write @F,@F1
 Quit R="F"
 ;
BOEKPER(R,Display) 
 New X
 Set R=+R
 Do ^cT163 Quit:'OK
 Set BoekPer=BP,BoekMnd=BM
 If $G(Display) Do PUT^vhScherm("BOEKPER",BoekPer)
 Quit
 ;
FAKTDAT(LevFANr) 
 New R
 Set LevFANr=$G(LevFANr)
 Set:'LevFANr LevFANr=$O(^Verv(LEVNr,"D",VervRef,LevFANr))
 If LevFANr Set R=$P(^Verv(LEVNr,"D",VervRef,LevFANr),D,2)
 Else  Set R=DT
 Quit $$INTDATE^vhDTyp(R)
 ;
VERVDAT(R,Display) 
 Set R=$TR($$EXTDATE^vhDTyp(R),"-",".")_D_BetVw
 Do ^cA104
 Set VervDat=$$INTDATE^vhDTyp(R)
 If $G(Display) Do PUT^vhScherm("VERVDAT",VervDat)
 Quit
 ;
MPAR(FromMunt,BoekJaar,Display) 
 New ToMunt
 Set:FromMunt="" FromMunt=$$FADEF^vhRtn1()
 Set ToMunt=$P($$MNTC^cAFE1(Q,BoekJaar),D)
 Set Pariteit=$$OMREK^cAFE1(Q,1,FromMunt,ToMunt,"A",99)
 If $G(Display) Do PUT^vhScherm("PARITEIT",Pariteit)
 Quit
 ;
BTWKODE() 
 Quit 8
 ;
%BTW(BtwKode) 
 Quit +$P(^KBA(18,BtwKode),D)
 ;
KKORT(LEVNr) 
 Quit +$P(^KLE(^KL1(LEVNr),0),D,17)
 ;
FAKTUUR 
 New R,X,BoekPer,BoekMnd,FaktDat,TFaktDat,VervDat,Pariteit,BtwKode,%Btw,Bedrag,MaatStaf,Btw,%KKort,KontKort
 New Next,BH,BJ,BM,BP,BX
 Quit:'$D(HULP)
 If @DL(1)@(6)'=1 Set DL(2)="HO" Do ML^PROC
 Set DL(2)=@DL(1)@(3),DL(3)=10
 Do PL^PROC
 If $$FINIT() Do
 .Set %Btw=$$%BTW(BtwKode),(TFaktDat,Next)="",DL(2)="DO"
 .For  Set Next=$O(HULP(Next)) Quit:Next=""  Do VERWERK(HULP(Next)),ML^PROC
 .Do EL^PROC
 .Set $P(^Verv(LEVNr,"D",VervRef),D,7)="F"
 Kill @DL(1)@(7)
 Set @DL(1)@(4)=21
 Do WL^PROC
 Kill DL(2),DL(3)
 Do RESET^vhScherm
 Quit
 ;
VERWERK(LevFANr) 
 New LvhFANr,Rec
 Set Rec=^Verv(LEVNr,"D",VervRef,LevFANr)
 If $P(Rec,D,8)!($P(Rec,D,9)) Quit
 If $P(Rec,D,2)'=TFaktDat Do
 .Set FaktDat=$$FAKTDAT(LevFANr)
 .Do VERVDAT(FaktDat),DISPLAY^vhScherm("BLCSBAF")
 .Set TFaktDat=$P(Rec,D,2)
 Set Bedrag=$P(Rec,D,5),MaatStaf=Bedrag,Btw=$J(Bedrag*%Btw/100,0,2),KontKort=$J(Bedrag*%KKort/100,0,2)
 Set LvhFANr=$$VERWERK^FCINK(LEVNr,LevFANr,FaktDat,VervDat,Bedrag,MaatStaf,Btw,KontKort,LevMunt,Pariteit,BH,BJ,BM,BP,BX)
 Set $P(Rec,D,8,9)="2\"_LvhFANr,^Verv(LEVNr,"D",VervRef,LevFANr)=Rec
 Quit
 ;
CHKMUNT(LEVNr,LevMunt,R)  ; De munt van de faktuur moet dezefde zijn als deze van de leverancier!
 If R=LevMunt Quit 1
 If $L(LevMunt),$D(^KBA(11,LevMunt)),R=$P(^KBA(11,LevMunt),D) Quit 1
 Quit 0
 ;
LVHFANR(R) 
 Quit:$P(R,D,9) $$EXTNUM^vhDTyp($P(R,D,9),0,".T",0)
 Quit $P("\Manuele faktuur\Kredietnota\Debetnota\Proforma\Debetnota\Kredietnota",D,+$P(R,D))
 ;
DELETE 
 New R,Gefakt
 Set Gefakt=$P(^Verv(LEVNr,"D",VervRef),D,7)
 Set R=$$ASKL^vhINP("BLCSBAF","DELETE") Quit:R'="V"
 Kill ^Verv(LEVNr,"D",VervRef),^Verv(LEVNr,"IA",VervRef)
 Set R=$O(^Verv(LEVNr,"D",""))
 Set Input=$S(R="":"-",1:"V")
 Quit
 ;
LOCK(Ref) 
 Do ADD^vhLock(Ref)
 If '%TC Do LDISP^vhLock(Ref,"Vervoerlijst")
 Quit %TC
 ;
MENU 
 New Rec
 Set Rec=^Verv(LEVNr,"D",VervRef,HULP(@DL(1)@(6))),R=""
 Do CALL^vhMenu("BLCSBAF")
 Quit
 ;
HELP 
 Write *7 Quit
 New HLP
 Set HLP(1)="BLCSBAF"
 Set HLP(3)=3
 Do ^HELP
 Do ADD^vhScherm(3,24)
 Quit
 ;