cTN8833(BM,MAP,DMS)	; Aankoopventilaties ; cTN8833                             [ 07/12/09  12:27:42 ]
	;
T0	;Aankoopventilaties
T1	;Fact/C.N. Datum Nummer-Naam leverancier\Tot. document\Netto;2\ Nummer & naam van de rekening\Bedrag;2;
T2	;Overdracht;Eindtotaal;
T3	; Journaalpost aankopen ;
T4	;facturen;creditnota's;
T5	; Debet\ Credit
T6	;Aftrekbare B.T.W.;
T7	;      Verschuldigde verlegging B.T.W.;
T8	;      Verschuldigde intracomm. B.T.W.;Verschuldigde B.T.W. Nelux;
T9	;      Verschuldigde B.T.W. O.H.;      Verschuldigde B.T.W. medecontr.;
T10	;Aftrekbare intracomm. B.T.W.;Aftrekbare B.T.W. Nelux;
T11	;Aftrekbare B.T.W. O.H.;Aftrekbare B.T.W. medecontr.;
T12	;      Verschuldigde B.T.W.;
T13	;Aftrekbare B.T.W. verlegging;
T14	;      Leveranciers
T15	; Totaal
	;
T0F	;Ventilations des achats ;
T1F	;Fact/N.C. Date  N° - Nom du fournisseur\Tot. document\Net;2\N° & Nom du compte\Montant;2;
T2F	;Transfert;Total final;
T3F	;Article de journal achats ;
T4F	;factures;notes de crédit;
T5F	;Débit\Crédit
T6F	;TVA déductible;
T7F	;TVA report de perception due;
T8F	;TVA intracomm. due;TVA Nelux due;
T9F	;TVA immobilière due;TVA cocontractant due;
T10F	;TVA I.C. déductible;TVA Nelux déductible;
T11F	;TVA immobilière déductible;TVA cocontractant déductible;
T12F	;TVA due;
T13F	;TVA report de perception déductible;
T14F	;Fournisseurs
T15F	;Total
	;
T0E	;Purchase ventilations ;
T1E	;Inv./C.N. Date  Number-Name supplier\Document tot.\Net;2\Number & name of the account\Amount;2;
T2E	;Transfer;Final total;
T3E	;Journal entry purchase ;
T4E	;invoices;credit notes;
T5E	;Debit\Credit;
T6E	;Deductable VAT;
T7E	;Due VAT transferred charges;
T8E	;Due VAT intracommunity;Due VAT Nelux;
T9E	;Due VAT Im.Ch.;Due VAT co-contractor;
T10E	;Deductible VAT intracommunity;Deductible VAT Nelux;
T11E	;Deducible VAT Im.Ch.;Deductible VAT co-cont.;
T12E	;Due VAT;
T13E	;Deducible VAT transferred charges;
T14E	;Suppliers
T15E	;Total
	;
T0D	;Aufteilung Einkäufe ;
T1D	;Rech/Kto. Datum Nr.- Lieferantenname\Belegtotal\Netto;2\Nr. & Kontenname\Betrag;2;
T2D	;Übertrag;Gesamttotal;
T3D	;Journalposition Einkaufsfakturen ;
T4D	;Rechnungen;Gutschriften;
T5D	;Soll\Haben
T6D	;MwSt-Abzug;
T7D	;Verschuldigde verlegging B.T.W.;
T8D	;Verschuldigde intracomm. B.T.W.;Verschuldigde B.T.W. Nelux;
T9D	;Verschuldigde B.T.W. O.H.;Verschuldigde B.T.W. medecontr.;
T10D	;Aftrekbare intracomm. B.T.W.;Aftrekbare B.T.W. Nelux;
T11D	;Aftrekbare B.T.W. O.H.;Aftrekbare B.T.W. medecontr.;
T12D	;Verschuldigde MWSt;
T13D	;Aftrekbare B.T.W. verlegging;
T14D	;Lieferanten
T15D	;Total
	;
1	S SWAV=""
	I $$SIG^cAFA1("Q",Q,401) S SWAV=1
	S REFREG=$$REF^cAFA10(Q,"REG")
	S UREFREG=$P(REFREG,D),IREFREG=$P(REFREG,D,3)     ; UREF/IREF voor ^DBH(Q,"REG"
	S UREFREG=$$REPL^cAFA10(UREFREG,"UI1","UI1REG")
	S REFKLA=$$REF^cAFA10(Q,"KL.A")
	S UREFKLA=$P(REFKLA,D)                            ; UREF voor ^DKL(,"KL.A"
	S UREFKLA=$$REPL^cAFA10(UREFKLA,"UI1","UI1KLA")
	S REFLEA=$$REF^cAFA10(Q,"LE.A")
	S UREFLEA=$P(REFLEA,D)                            ; UREF voor ^DLE(,"LE.A"
	S UREFLEA=$$REPL^cAFA10(UREFLEA,"UI1","UI1LEA")
	S REFJRN=$$REF^cAFA10(Q,"JRN")
	S UREFJRN=$P(REFJRN,D)                            ; UREF voor ^DBH(,"JRN"
	S UREFJRN=$$REPL^cAFA10(UREFJRN,"UI1","UI1JRN")
	S REFDAR=$$REF^cAFA10(Q,"AR.A")
	S UREFDAR=$P(REFDAR,D)                            ; UREF voor ^DAR(Q,"AR.A"
	S UREFDAR=$$REPL^cAFA10(UREFDAR,"UI1","UI1DAR")
	S REFDB=$$REF^cAFA10(Q,"DB")
	S UREFDB=$P(REFDB,D),IREFDB=$P(REFDB,D,3)         ; UREF/IREF voor ^DBH(Q,"DB"
	S UREFDB=$$REPL^cAFA10(UREFDB,"UI1","UI1DB")
	S SRT="A"
	S LN=0
	K ^HULP(boot,$J),^HULP(boot,$J+.01)
	;
	S BP=BM ; $E(BM,1,4)_"."_$E(BM,5,6)
	S BM=$TR(BM,".")
	K AFBTWD,AFBTWC,NAFBTWD,NAFBTWC,BTWTYPE,TYPEBTW
	;
	S FNR=""
11	S FNR=$O(@IREFDB@("M1",Q,"A",BM,FNR)) G 17:FNR="" S UI1DB=""
13	S UI1DB=$O(@IREFDB@("M1",Q,"A",BM,FNR,UI1DB)) G 11:UI1DB="" S UI1REG=""
	S NULDB=@UREFDB@(0),DRIEDB=^(3)
15	S (NULREG,EENREG)=""
	S UI1REG=$O(@IREFREG@("M1",Q,"A",$TR(UI1DB," "),UI1REG))
	G 13:UI1REG=""
	I $L(UI1REG) S NULREG=@UREFREG@(0),EENREG=^(1)
	I $L(UI1REG) I '$P(NULREG,D,32) G 15       ; alleen manuele registraties beschouwen, automatische niet
	S JRN=$P(NULDB,D,2)
	S HULPINH=""
	S KCA=$P(NULDB,D,10)
	S FC=$P(NULDB,D,23)
	S $P(HULPINH,D)=$P(NULDB,D,23)_" "_FNR_" "_$P($P(NULDB,D,7),".",1,2)_" "_$$SIG^cAFA1("LE.A",KCA,101)_"-"_$P(^(0),D,2)
	S $P(HULPINH,D,2)=$P(NULDB,D,16)
	S $P(HULPINH,D,3)=$P(DRIEDB,D)
	S ARA=$P(NULREG,D,8)
	S ARAOMS="",ARANR=""
	I $L(UI1REG) S ARAOMS=$$SIG^cAFA1("AR.A",ARA,205+((QTU-1)*2)),ARANR=$P(^(0),D)
	S DARA=$P(NULREG,D,9)
	S DARANR=""
	I DARA S DARANR=$$SIG^cAFA1("ARA.A",DARA,101)
	I ARANR S $P(HULPINH,D,4)=ARANR_"-"_ARAOMS_$S($L(DARANR)&(SWAV):"      "_DARANR,1:"")
	S DEBET=$P(NULREG,D,15),CREDIT=$P(NULREG,D,16)
	S $P(HULPINH,D,5)=$S(DEBET:DEBET,1:-CREDIT)
	S ^HULP(boot,$J+.01,JRN,UI1REG)=HULPINH
	I ARANR S $P(JRNFAC(ARA),D)=$P($G(JRNFAC(ARA)),D)+DEBET
	I ARANR S $P(JRNFAC(ARA),D,2)=$P($G(JRNFAC(ARA)),D,2)+CREDIT
	I DEBET S AFBTWD(FNR)=$P(DRIEDB,D,10),NAFBTWD(FNR)=$P(DRIEDB,D,11)
	I CREDIT S AFBTWC(FNR)=$P(DRIEDB,D,10),NAFBTWC(FNR)=$P(DRIEDB,D,11)
	S TYPEBTW=$P(DRIEDB,D,12)
	I TYPEBTW S BTWTYPE(FC,TYPEBTW)=$G(BTWTYPE(FC,TYPEBTW))+$P(DRIEDB,D,13)
	;
	G 15:$L(UI1REG),13
	;
	; aflopen ^HULP(boot,$J+.01 voor afdrukken per journaal
17	S JRN=""
	S BM=$TR(BM,".")
	S MNM=$P($T(@("T0"_QT)),U,2)_": "_^cBA(2,$E(QT_"N"),BP#1*100)_" "_(BP\1)
	S HD(1)=D_MNM_";C;F82",HD(2)="",HD(3)=""
2	S TIT(1)=$P($T(@("T1"_QT)),U,2,99)
	S TAB="49\65\81\115\131"
	;
20	S JRN=$O(^HULP(boot,$J+.01,JRN)) G Y:JRN=""
	S UI1JRN=JRN
	S JRNCO=$P(@UREFJRN@(0),D),JRNOMS=$P(@UREFJRN@(0),D,2+((QTU-1)*10))
	S HD(2)=D_JRNCO_" - "_JRNOMS_";C"
	S SAL=0
	S I4="",(FNR,OFNR)=""
21	S I4=$O(^HULP(boot,$J+.01,JRN,I4)) S REGINH="" G 23:I4="" S REGINH=^(I4)
	S TXT(1)=$P(REGINH,D)
	S FNR=$P(TXT(1)," ",2)
	S TXT(2)=$P(REGINH,D,2)_D_1_D_D_D_1_D_QD
	S TXT(3)=$P(REGINH,D,3)_D_1_D_D_D_1_D_QD
	S TXT(4)=$P(REGINH,D,4)
	S TXT(5)=$P(REGINH,D,5)_D_1_D_D_D_1_D_QD
	I FNR=OFNR S TXT(2)="",TXT(3)=""
	S AFS(1,2)=$G(AFS(1,2))+TXT(2)
	S AFS(1,2)=AFS(1,2)_D_1_D_D_D_1_D_QD
	S AFS(1,3)=$G(AFS(1,3))+TXT(3)
	S AFS(1,3)=AFS(1,3)_D_1_D_D_D_1_D_QD
	I FNR'=OFNR S OFNR=FNR
	D ^cA334
	G 21
	;
	; einde journaal
23	S END=145
	D ^cA334
	F I=1:1:5 S TXT(I)=""
	S TXT(1)=$P($T(@("T2"_QT)),U,3)
	S TXT(2)=AFS(1,2)
	S TXT(3)=AFS(1,3)
	D ^cA334
	S END=4
	D ^cA334
	;
	; Journaalpost facturen
	;
25	K AFS
	S TAB="70\85\100"
	S TIT(1)=$P($T(@("T3"_QT)),U,2)_$P($T(@("T4"_QT)),U,2)_D_$P($T(@("T5"_QT)),U,2)
	S ARA="",TOTLEV=0
26	S ARA=$O(JRNFAC(ARA)) G 27:ARA="" S INH=JRNFAC(ARA)
	I '$P(INH,D) G 26  ; geen debet - waarde -> skippen
	S UI1DAR=ARA
	S TXT(1)=$P(@UREFDAR@(0),D)_" "_$P(^(1),D,5+((QTU-1)*2))
	S TXT(2)=$P(INH,D)_D_1_D_D_D_1_D_QD
	S TOTLEV=TOTLEV+$P(INH,D)
	S AFS(1,2)=$G(AFS(1,2))+$P(INH,D)
	S TXT(3)=""
	D ^cA334
	G 26
	;
27	S TOTAFBTW=0,FNR=""
	F  S FNR=$O(AFBTWD(FNR)) Q:FNR=""  S TOTAFBTW=TOTAFBTW+AFBTWD(FNR)
	S TXT(1)=$P($T(@("T6"_QT)),U,2)
	S TXT(2)=TOTAFBTW_D_1_D_D_D_1_D_QD
	S TOTLEV=TOTLEV+TOTAFBTW
	S AFS(1,2)=AFS(1,2)+TOTAFBTW
	S TXT(3)=""
	D ^cA334
	;
28	S TYPE=""
281	S TYPE=$O(BTWTYPE("F",TYPE)) G 29:TYPE="" S BTWBEDR=BTWTYPE("F",TYPE)
	S UI19031=$$SIG^cAFA1("CODE.9032",TYPE,104)
	S TYPE9031=$$SIG^cAFA1("CODE.9031",UI19031,101)
	I TYPE9031=0 S TXT(1)=$P($T(@("T9"_QT)),U,2)
	I TYPE9031=1 S TXT(1)=$P($T(@("T8"_QT)),U,2)
	I TYPE9031=3 S TXT(1)=$P($T(@("T9"_QT)),U,3)
	I TYPE9031=4 S TXT(1)=$P($T(@("T7"_QT)),U,2)
	I TYPE9031=5 S TXT(1)=$P($T(@("T6"_QT)),U,2)
	S (TXT(2),TXT(3))=""
	S TXT(2)=BTWBEDR_D_1_D_D_D_1_D_QD I BTWBEDR<0 S TXT(3)=-BTWBEDR_D_1_D_D_D_1_D_QD,TXT(2)=""
	S TOTLEV=TOTLEV+TXT(2)-TXT(3)
	S AFS(1,2)=AFS(1,2)+TXT(2)
	S AFS(1,3)=$G(AFS(1,3))+TXT(3)
	D ^cA334
	G 281
	;
	; bedrag leveranciers
29	S TXT(1)=$P($T(@("T14"_QT)),U,2)
	S TXT(2)=TOTLEV_D_1_D_D_D_1_D_QD
	I TOTLEV>0 S TXT(2)="",TXT(3)=TOTLEV_D_1_D_D_D_1_D_QD
	S AFS(1,2)=AFS(1,2)+TXT(2)
	S AFS(1,3)=AFS(1,3)+TXT(3)
	D ^cA334
	S AFS(1,1)=$P($T(@("T15"_QT)),U,2)
	S AFS(1,2)=AFS(1,2)_D_1_D_D_D_1_D_QD
	S AFS(1,3)=AFS(1,3)_D_1_D_D_D_1_D_QD
	S END=4 D ^cA334
	;
	; journaalpost creditnota's
3	K AFS
	S TIT(1)=$P($T(@("T3"_QT)),U,2)_$P($T(@("T4"_QT)),U,3)_D_$P($T(@("T5"_QT)),U,2)
	;
Y	S END=6 D ^cA334
	K ^HULP(boot,$J),^HULP(boot,$J+.01)
YZ	Q
	;
ZZ	; 18.05.09 - FB/GM