cTN1101	; Aankoop : Dagboek: specifieke controles en locks ; cTN101;      [ 17/11/09  10:34:30 ]
	;
T1	;Geboekt bedrag verschilt van netto bedrag document.;
T2	;AR.A#Basisrekening ;ARA.A#Analytische rekening ;EC1#EC1-code ;EC2#EC2-code ;EC3#EC3-code ;
T3	;Gecontroleerde levering ;
	;
T1F	;Montant imputé diffère du montant net du document.;
T2F	;AR.A#Compte de base ;ARA.A#Compte analytique ;EC1#Code EC1 ;EC2#Code EC2 ;EC3#Code EC3 ;
T3F	;Livraison controlée ;
	;
T1E	;The booked amount is different from the net amount of the document.;
T2E	;AR.A#Base account ;ARA.A#Analytical account ;EC1#EC1-Code ;EC2#EC2-Code ;EC3#EC3-Code ;
T3E	;Checked delivery ;
	;
YZ	Q
	;
CHK(GRIDID,PAR)	; Specifieke controles voor aankoopdocument
	; Input: GRIDID: GridId
	; ;      PAR:    Parameters, gescheiden door "\"
	;                1. Switch bedragen
	;                   "" of 0: bedragen doorgegeven in munt document
	;                   1:       bedragen doorgegeven in munt BH
	; Output: 1: Alles OK
	;         0\Foutboodschap
	N RZR,OK,DB,N,NETG,NETD,NETI,NETA,AFBTW,NABTW,TBTW,TOT,V,BEDR       
	S $ZT="TRAP^cAN000"
	;        
	; Onthouden last reference
CHK1	D S1^cAFA1
	;
	; Controle parameters + variabelen opzetten
CHK2	S OK=1 I '$L($G(GRIDID)) G CHKZ
	S DB=$O(^mtemp99(GRIDID,"BH.DB","")) I '$L(DB) G CHKY
	S DB(1)=$G(^mtemp99(GRIDID,"BH.DB",DB,0)) F N=1:1:6  S DB(N+1)=$G(^(N))
	S PAR=$G(PAR)
	;
	; Check of totalen kloppen
CHK3	S BN=5,BSW=0 I $P(PAR,D) S BN=4,BSW=3 ; Node met bedragen
	S NETG=$P(DB(BN),D),NETD=$P(DB(BN),D,2),NETI=$P(DB(BN),D,3),NETA=$P(DB(BN),D,4)
	S AFBTW=$P(DB(BN),D,10),NABTW=$P(DB(BN),D,11),TBTW=$P(DB(BN),D,13),TOT=$P(DB(1),D,19-BSW)
	S OK=$$CHKTOT^cTN1112(TOT,NETG,NETD,NETI,NETA,AFBTW,NABTW,TBTW) 
	I 'OK S OK=0_D_$P(OK,D,2) G CHKY
	;
	; Check of totaal van de ventilaties gelijk is aan totaal te ventileren
CHK4	S (V,BEDR)="" S SWB=0 I $P(PAR,D) S SWB=-2	
CHK40	S V=$O(^mtemp99(GRIDID,"BH.REG",V)) G:'$L(V) CHK45
	S N=^(V,0) I $P(N,D,30)=2 G CHK40 ; Verwijderd
	S BEDR=BEDR+$P(N,D,17+SWB)-$P(N,D,18+SWB)
CHK43	G CHK40
CHK45	I +BEDR=$$VENT^cTN1112(NETG,NETD,NETI,NETA,NABTW) G CHK5
CHK49	S OK=0_D_$P($T(@("T1"_QT)),U,2)_" ("_+BEDR_" <-> "_$$VENT^cTN1112(NETG,NETD,NETI,NETA,NABTW)_")" G CHKY
	;
	; Check op basisrekeningen
CHK5	S OK=$$CHKBA^cTN1112($P(DB(4),D,12),$P(DB(1),D,23)) I 'OK G CHKY
	;
	; Terugzetten last reference
CHKY	D S2^cAFA1
	;
CHKZ	Q OK
	;
DB(GRIDID,PAR)	; Aanpassen hoofding specifieke velden voor aankoop
	; Input: GRIDID: GridId
	;        PAR:    Parameters, gescheiden door "\"
	;                1. Switch omrekenen # Afwijkende pariteit
	;                   "" of 0: munt BH opzetten aan de hand van munt document
	;                   1:       munt document opzetten aan de hand van munt BH
	N RZR,DB,NETG,NETD,NETI,NETA,MST,AFBTW,NABTW,TBTW,MPAR,TOTBH,PC,i,TOTBH2
	N VERS,MAX,MAXBEDR,I,MAXi,TMST,MSTD,MSTI,MSTA,MSTG,MAXMST,MNTI,MNTO,BN,ON,APAR
	S $ZT="TRAP^cAN000"
	; 
	; Onthouden last reference
DB1	D S1^cAFA1
	;
	; Controle parameters + variabelen opzetten
DB2	I '$L($G(GRIDID)) G DBY
	S GDB="^mtemp99(GRIDID,""BH.DB"")"
	S DB=$O(@GDB@("")) I '$L(DB) G DBY
	S DB(1)=$G(^(DB,0)),DB(4)=$G(^(3)),DB(5)=$G(^(4))
	S BN=5,ON=4 I $P($G(PAR),D) S BN=4,ON=5 ; Basis- en omrekennode bepalen
	S APAR=$P($P(PAR,D),"#",2)    ; Afwijkende pariteit
	;
	; Munt BH opzetten aan de hand van munt document
DB3	S NETG=$P(DB(BN),D),NETD=$P(DB(BN),D,2),NETI=$P(DB(BN),D,3),NETA=$P(DB(BN),D,4),MST=$P(DB(BN),D,5)
	S AFBTW=$P(DB(BN),D,10),NABTW=$P(DB(BN),D,11),TBTW=$P(DB(BN),D,13),MPAR=1/$S($L(APAR):APAR,1:$P(DB(1),D,27)),MNTI=$P(DB(1),D,14),MNTO=""
	S TOTBH=$P(DB(1),D,16+(5-BN*3))
	I BN=4 S MNTO=MNTI,MNTI="",MPAR=1/MPAR
	; Maatstaven in munt document
DB31	D MST S $P(DB(BN),D,6)=MSTG,$P(DB(BN),D,7)=MSTD,$P(DB(BN),D,8)=MSTI,$P(DB(BN),D,9)=MSTA,@GDB@(DB,BN-1)=DB(BN)
	; Alles omrekenen naar munt BH
DB32	F PC=1:1 S i=$P("NETG\NETD\NETI\NETA\AFBTW\NABTW\TBTW\MST\MSTG\MSTD\MSTI\MSTA",D,PC) Q:i=""  S @i=$$OMREK^cTN001(.Q,@i,MNTI,MNTO,"","","",MPAR) ;S @i=$$OMREK^cTN001(.Q,@i,MNTI,MNTO,"",$S(MNTI="":"",1:MPAR),$S(MNTO="":"",1:MPAR))
	; Wegwerken omrekenverschil
	S TOTBH2=NETG+NETD+NETI+NETA+AFBTW+NABTW+TBTW
DB33	S VERS=TOTBH-TOTBH2 I 'VERS G DB37
	S MAX="NETG",MAXBEDR=NETG S:MAXBEDR<0 MAXBEDR=-MAXBEDR F I="NETD","NETI","NETA" D
	. S BEDR=@I I BEDR<0 S BEDR=-BEDR
	. I BEDR>MAXBEDR S MAXBEDR=BEDR,MAX=I	
DB35	S @MAX=@MAX+VERS,MST=MST+VERS
	; Totalen in munt BH opzetten 
DB37	S $P(DB(ON),D)=NETG,$P(DB(ON),D,2)=NETD,$P(DB(ON),D,3)=NETI,$P(DB(ON),D,4)=NETA,$P(DB(ON),D,5)=MST
	S $P(DB(ON),D,10)=AFBTW,$P(DB(ON),D,11)=NABTW,$P(DB(ON),D,13)=TBTW
	S @GDB@(DB,ON-1)=DB(ON)
	; Maatstaven in munt BH
DB39	D MST S $P(DB(ON),D,6)=MSTG,$P(DB(ON),D,7)=MSTD,$P(DB(ON),D,8)=MSTI,$P(DB(ON),D,9)=MSTA,@GDB@(DB,ON-1)=DB(ON)
	;
	; IC-investering uitblanken indien niet van toepassing
DB41	I '$$CHKINV^cTN1111($P(DB(1),D,5),$P(DB(4),D,3),$P(DB(4),D,12)) S $P(DB(4),D,36)="",@GDB@(DB,3)=DB(4)
	;
	; Terugzetten last reference
DBY	D S2^cAFA1
	; 	
DBZ	Q
	;
LOCK(GRIDID,LOCK,SWO2N)	
	; Input: GRIDID: GridId
	; 	 LOCK:   Tabel met gelockte ID's, als referentie doorgeven (.LOCK)
	; 	         Inhoud tabel, gescheiden door "\"
	; 	         1. DMS
	; 	         2. Gelockt ID
	; 	SWO2N :  1 = van oud naar nieuw
	;
	S $ZT="TRAP^cAN000"
	N @$$INITVAR^cAFVBA01("GRIDID,LOCK,SWO2N")
	;
	; Onthouden last reference
LOCK1	D S1^cAFA1
	;
	; Controle parameters + variabelen opzetten
LOCK2	S OK=1 I '$L($G(GRIDID)) G LOCKZ
	S DB=$O(^mtemp99(GRIDID,"BH.DB","")) I '$L(DB) G LOCKY
	S DB(1)=$G(^mtemp99(GRIDID,"BH.DB",DB,0)) F N=1:1:6  S DB(N+1)=$G(^(N))
	S FC=$P(DB(1),D,23)
	S SWNB=0 I $$PAR^cTN001(Q,201)=2 S SWNB=1  ; 1 : enkel nieuwe BH
	; 
	; Alle rekeningen proberen te locken	
LOCK3	S BREK=$$SIGN^cAFA1("Q",$$Q^cAFA10(),3)               ; Basisrekeningen
	S BREK(1)=$P(BREK,D,2)                                ; Leveranciersrekening
	;S BREK(2)=$P(BREK,D,5+(FC="C"))           
	S AFBTW=$$UI1OP^cAFA1("CODE.9032","104","",1004)
	S BREK(2)=$$SIG^cAFA1("CODE.9032",AFBTW,106+(FC="C")) ; Aftrekbare / verschuldigde BTW
	I $L($P(DB(4),D,12)) S BREK(3)=$$SIG^cAFA1("CODE.9032",$P(DB(4),D,12),106+(FC="C")) ; BTW-type
 	;
 	I $G(SWO2N) G LOCK4  ; van oud naar nieuw
 	; 
 	; Basisrekeningen
LOCK31 	S i=""
LOCK32	S i=$O(BREK(i)) I '$L(i) G LOCK4
	S (UI1,BREK)=BREK(i),j=2 
LOCK34	I '$L(UI1) G:j>2 LOCK35 G LOCK32
	S DMS=$P($P($T(@("T2"_QT)),U,j),"#")
	S TXT=$P($P($T(@("T2"_QT)),U,j),"#",2)_$$SIG^cAFA1(DMS,UI1,101)
	; Lock
	I 'SWNB S OK=$$LOCK^cAFVBA01(.Q,DMS,UI1,1,TXT_"~"_"~3") I 'OK G LOCK9
	I 'SWNB S L=($O(LOCK("zzz"),-1)+1) S LOCK(L)=DMS_D_UI1_D_D_1
	; Controle of rekening niet verwijderd is
	S OK=$$CTRLREK^cTN003("",UI1,DMS,TXT) I 'OK G LOCK9
	; Vaste analytische + EC-rekeningen
LOCK35	S j=j+1 I j>6 G LOCK32
	S UI1=$$SIG^cAFA1("AR.A",BREK,157+((j-3)*3))
	G LOCK34
	;
	; Link met aankoop: gecontroleerde leveringen locken 
LOCK4	S LREF=$P(DB(1),D,24) I '$L(LREF) G LOCK5
	S LREF=$$DI^cAN000(LREF,"")
	S LENR=$$SIG^cAFA1("LE.A",$P(DB(1),D,10),101) I '$L(LENR) G LOCK5
	S UR="",QAK=$$QAK^cTN1114($$Q^cAFA10)
	S REF="^"_QAK_"TOA6(LENR,LREF)"
	I $D(@REF) S SWTOA6=1 G LOCK41
	S REF="^"_QAK_"TOA(LENR,LREF)"
LOCK41	S UR=$O(@REF@(UR)) G LOCK5:'$L(UR) 
	S US=$S($G(SWTOA6):"P",1:$P(^(UR),D)),RQ=$P(^(UR),D,2) I RQ="" S RQ=QAK
LOCK43	G LOCK41:'$D(@("^"_RQ_"TOL(LENR,US,$P(UR,"" "",$G(SWTOA6)+1),1)")) 
LOCK45	S LCKREF="^"_RQ_"TOL("_LENR_","""_US_""","_$P(UR," ",$G(SWTOA6)+1)_")"
	S TXT=$P($T(@("T3"_QT)),U,2)_$P(UR," ",$G(SWTOA6)+1)
	S OK=$$PLUS^cANLOCK(LCKREF,"",TXT,0,2) I 'OK G LOCK9
	S L=($O(LOCK("zzz"),-1)+1) S LOCK(L)=""_D_""_D_LCKREF
	G LOCK41
	;
	; Link met toestel: toestellen locken
LOCK5	; S OK=$$LINKAA^cANP0005($P(DB(1),D,10),$P(DB(1),D,24),-1,.LOCK) I 'OK G LOCK9
	I OK G LOCKY
	;
	; Alle gelockte ID's unlocken
LOCK9	D UNLOCK^cTN1012(.LOCK)
	;
	; Terugzetten last reference
LOCKY	D S2^cAFA1
	;
LOCKZ	Q OK
	;
	; Maatstaven: opsplitsing G/D/I/A
MST	S TMST=NETG+NETD+NETI,(MSTD,MSTI,MAXMST,MAXBEDR)=0,MSTG=MST,MSTA=NETA
	I TMST F PC=1:1  S i=$P("G\D\I",D,PC) Q:i=""  S MSTi="MST"_i,@MSTi=$J(@("NET"_i)/TMST*MST,0,QD) S:@MSTi<0 @MSTi=-@MSTi I @MSTi>MAXBEDR S MAXBEDR=@MSTi,MAXMST=PC
	S VERS=MST-MSTG-MSTD-MSTI I VERS'=0 S MAXi="MST"_$P("G\D\I",D,MAXMST),@MAXi=@MAXi+VERS
MSTZ	Q
	;
	;
ZZ	; 26.02.09 - 10 u 24 * V9.05