Index: cAFI1.mac.rou
===================================================================
diff -u -r734 -r3199
--- cAFI1.mac.rou	(.../cAFI1.mac.rou)	(revision 734)
+++ cAFI1.mac.rou	(.../cAFI1.mac.rou)	(revision 3199)
@@ -1,89 +1,147 @@
-cAFI1 ;Inputcontroles ;%AFI1 ; [ 01/03/01  5:13 PM ]
- ;
-T0 ;Inputcontroles ;
-T1 ; heeft zelfde BTW-nummer\".[] = doorgaan";
- ;
-T0F ;Controle d'entr�e ;
-T1F ; a le m�me num�ro\".[] = continuer";
- ;
-T0E ;Inputcontrols ;
-T1E ; has the same VAT-number\".[] = continue";
- ;
-BANK(NR) ; bank-nummer
- N R,RK,RL,RLI
- S (K,RK)=$$UC^cAFA1(NR),R=1,RL=$P(@("^"_Q_"BA(39)"),D,3),RLI=$P(K,"-")
- S:RLI?1U.U K=$P(K,"-",2,99) S:RLI'?1U.U RLI=RL I $D(^BA(6,RLI)) D
- . S R=0 I @^(RLI,1) S R=1
- S K=RK I R,$P(K,"-")=RL S K=$P(K,"-",2,99)
- Q R
- ;
-BET(R,W) ; betalingstermijn
- N R0,R1,R2,R3
- S R0=0 I "-"[R!(R=",") S R0=1 G BETZ
- S K=$$UC^cAFA1(R)
- I QT="F",K["J"!(K["F")!(K["+D")!(K["-T") S K=$TR(K,"JFDT","DECW")
- S R2=$TR(K,"0123456789",""),R1=$P(K,R2),R2=D_R2_D
- S R3="\D\M\DEM\MEM\DEC\MEC\D+C\M+C\DEM+C\MEM+C\DEC+C\MEC+C\"
- I '$G(W) S R3=R3_"D-W\M-W\DEM-W\MEM-W\DEC-W\MEC-W\D+C-W\M+C-W\DEM+C-W\MEM+C-W\DEC+C-W\MEC+C-W\"
- I R3[R2&(R1?1.N) S R0=1
-BETZ Q R0
- ;
-BTW(NR,DMS) ; BTW-nummer
- ; DMS : wordt meegegeven als moet getest worden op dubbel BTW-nr
- N R,RK,RL,RLI
- S (K,RK)=$$UC^cAFA1(NR),R=1,RL=$P(@("^"_Q_"BA(39)"),D,4),RLI=$E(K,1,2)
- S:RLI?2U K=$E(K,3,99) S:RLI'?2U RLI=RL I $D(^BA(5,RLI)) D
- . S R=0 I @^(RLI,1) S R=1
- . I K=0 S RK=RLI_$E(1E20,2,$P(^(0),D,2)+1)
- S K=RK I R,$E(K,1,2)=RL S K=$E(K,3,99)
- I R,$L($G(DMS)),'$$BTWD(DMS,K) S R=0
- Q R
- ;
-BTWD(DMS,NR) ; testen of BTW-nummer uniek is
- ; NR = BTW-nummer
- N R,K,OK
- S OK=1
- I '$L(NR)!(NR?."0")!(NR?2A."0") G BTWDZ
- I $D(A(1)),$P(A(1),D,16)=NR G BTWDZ  ; indien wijzigen
- S R=$$UI1^cAFA1(DMS,116,NR) I '$L(R) G BTWDZ
- S R=$$SIG^cAFA1(DMS,R,102)_" ("_$P(^(0),D)_")"
- S R="K\22\3\"_R_$P($T(@("T1"_QT)),U,2)_"\1\\"".-""[K&$L(K)" D R0
- I K'="." S OK=0
-BTWDZ Q OK
- ;
-DCTR(K) ; datum
- N R S R=0
- I K?2N1"."2N1"."2N&$E(K,1,2)&$E(K,4,5)&($E(K,1,2)<32)&($E(K,4,5)<13)&'("04060911"[$E(K,4,5)&($E(K,1,2)=31))&'(+$E(K,4,5)=2&(('($E(K,7,8)#4)&($E(K,1,2)>29))!($E(K,7,8)#4&($E(K,1,2)>28))))!("-,"[K) S R=1
- Q R
- ;
-JJJJMM(K)          ; geldige maand
- N R S R=0
- I K?4n1"."2n,K\1>1979,K\1<2050,K#1,K#1<.13 S R=1
- Q R
- ;
-KO(UQC,USC,UI1)    ; test geldige kode
- N UREF,R,RI,UDD
- S UI1=$$DP^cAFA1($$UC^cAFA1(UI1))_" "
- S R=0 I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
- . S UREF=^DMC(UQC,USC,"DATA","REF"),R=$D(@UREF) I R S K=$P(UI1," ")
- Q R
- ;
-BP(K,VM) ; kontrole basisprijs van de aankoopgegevens produkten       *** BG ***
- n DEC,R
- s DEC=$$DEC^cAFA1(VM)
- i VM=$P(@("^"_Q_"BA(39)"),D),$D(@("^"_Q_"PR(0,19)")) s DEC=$P(^(19),D,22)
- s R=0 i @("K?.N!(K?.N1"".""."_DEC_"N)&DEC") s R=1
- q R
- ;
-UM(DMS,I1,I2,MU)    ; testen van bestaand multiple van 2 indexen      *** BG ***
- N I,IREF,R,UQC,USC
- D DMS^cAN000("UQC","USC",DMS)
- S R=0 I $L(UQC),$L(USC),$D(^DMC(UQC,USC,"DATA")) D
- . S IREF=$G(^("DATA","INDEX"))
- . S I1=$P($$DI^cAN000(I1,"")," "),I2=$$DI^cAN000(I2,"")
- . I $L(MU),$L(I1) S I=$O(@IREF@(MU,I1,I2)) I $E(I,1,$L(I2))=I2 S R=1
- Q R
- ;
-R0 S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
- ;
-ZZ ; 05.02.01 - 16 u 23 * V7.84
\ No newline at end of file
+cAFI1	;Inputcontroles ;%AFI1 ; [ 01/25/02  1:39 PM ]
+	;
+T0	;Inputcontroles ;
+T1	; heeft zelfde BTW-nummer\".[] = doorgaan";
+T2	;'LL' is niet toegelaten (LL = NL, DE, FR, GB, ...);
+	;
+T0F	;Controle d'entr�e ;
+T1F	; a le m�me num�ro\".[] = continuer";
+T2F	;'LL' n'est pas permise (LL = NL, DE, FR, GB, ...);
+	;
+T0E	;Inputcontrols ;
+T1E	; has the same VAT-number\".[] = continue";
+T2E	;'LL' is not allowed (LL = NL, DE, FR, GB, ...);
+	;
+T0D	;Inputcontroles ;
+T1D	; heeft zelfde BTW-nummer\".[] = doorgaan";
+T2D	;'LL' is niet toegelaten (LL = NL, DE, FR, GB, ...);
+	;
+BANK(NR)	; bank-nummer
+	Q $$BANK^cAFI2(NR)
+	;
+BET(R,W,CODE)	; betalingstermijn
+	N R0,R1,R2,R3
+	S R0=0 I "-"[R!(R=",") S R0=1 G BETZ
+	S K=$$UC^cAFA1(R)
+	I QT="F",K["J"!(K["F")!(K["+D")!(K["-T") S K=$TR(K,"JFDT","DECW")
+	I QT="D",K["T" S K=$TR(K,"T","D")
+	S R2=$TR(K,"0123456789",""),R1=$P(K,R2),R2=D_R2_D
+	S R3="\D\M\DEM\MEM\DEC\MEC\D+C\M+C\DEM+C\MEM+C\DEC+C\MEC+C\"
+	I '$G(W) S R3=R3_"D-W\M-W\DEM-W\MEM-W\DEC-W\MEC-W\D+C-W\M+C-W\DEM+C-W\MEM+C-W\DEC+C-W\MEC+C-W\"
+	I R3[R2&(R1?1.N) S R0=1
+	; Indien correcte betalingstermijn: controleren of bestaand in CODE.9024 of CODE.9028
+	I R0=1 D CODEBET(K,$S('$L($G(CODE)):"CODE.9024",1:CODE))
+BETZ	Q R0
+	;
+BTW(NR,DMS)	; BTW-nummer
+	; DMS : wordt meegegeven als moet getest worden op dubbel BTW-nr
+	N R,RK,RL,RLI
+	I '$L(NR)!(NR="-") S R=1 G BTWZ
+	S (K,RK)=$$UC^cAFA1(NR),R=1,RL=$P(@("^"_Q_"BA(39)"),D,4),RLI=$E(K,1,2)
+	I $E(K,1,2)="LL" S K=$P($T(@("T2"_QT)),U,2) D TXT^cAFA1(250) S R=0 G BTWZ
+	I RLI'?2U S R=0 G BTWZ
+	S:RLI?2U K=$E(K,3,99) S:RLI'?2U RLI=RL 
+	I $D(^BA(5,RLI)) D
+	. I $L($G(^BA(5,RLI,3))) X ^(3)
+	. S R=0 I @^BA(5,RLI,1) S R=1
+	. I K=0 S K=$E(1E20,2,$P(^(0),D,2)+1)
+	I 'R S K=RK
+	I R S K=RLI_K
+	; S K=RK I R,$E(K,1,2)=RL S K=$E(K,3,99)
+	I R,$L($G(DMS)),'$$BTWD(DMS,K) S R=0
+BTWZ	Q R
+	;
+BTWBE(K)	; controle op Belgisch BTW-nummer
+	N R S R=0
+	I K?10N I 97-($E(K,1,8)#97)=+$E(K,9,10) S R=1
+	Q R
+	;
+BTWD(DMS,NR)	; testen of BTW-nummer uniek is
+	; NR = BTW-nummer
+	N R,K,OK
+	S OK=1
+	I '$L(NR)!(NR?."0")!(NR?2A."0") G BTWDZ
+	I $D(A(1)),$P(A(1),D,16)=NR G BTWDZ  ; indien wijzigen
+	S R=$$UI1^cAFA1(DMS,116,NR) I '$L(R) G BTWDZ
+	S R=$$SIG^cAFA1(DMS,R,102)_" ("_$P(^(0),D)_")"
+	S R="K\22\3\"_R_$P($T(@("T1"_QT)),U,2)_"\1\\"".-""[K&$L(K)" D R0
+	I K'="." S OK=0
+BTWDZ	Q OK
+	;
+CODEBET(CODE,DMS)	; Controleren of code reeds bestaat in CODE.9024 of CODE.9028
+	N UQC,USC,UREF,UI1,TAB,TYPE,K
+	S $ZT="TRAP^cAN000"
+	D DMS^cAN000("UQC","USC",DMS,1)
+	I '$L(UQC)!'$L(USC) G CODEBETZ
+	S UREF=^DMC(UQC,USC,"DATA","REF")
+	S UI1=$$UI1OP^cAFA1(DMS,110,"",CODE)
+	; Indien code bestaat en operationeel: er gebeurt niets
+	I $L(UI1),'$P(@UREF@(0),D,30) G CODEBETZ
+	; Indien code bestaat en buiten gebruik: in gebruik zetten
+	I $L(UI1) D W^cAN220(DMS,"",UI1,130,0) X:K="-" "STOP" G CODEBETZ
+	; Indien code niet bestaat: openen
+	K TAB
+	; Aantal
+	S $P(TAB(1),D,3)=+CODE
+	; Type
+	S TYPE=$P(CODE,$P(TAB(1),D,3),2)
+	I TYPE["-" S TYPE=$P(TYPE,"-")
+	I TYPE["+" S TYPE=$P(TYPE,"+")
+	I TYPE="D"!(TYPE="J")!(TYPE="T") S TYPE=0
+	I TYPE="DEM"!(TYPE="JFM")!(TYPE="TEM") S TYPE=1
+	I TYPE="M" S TYPE=2
+	I TYPE="MEM"!(TYPE="MFM") S TYPE=3
+	I TYPE="DEC"!(TYPE="JFC")!(TYPE="TEC") S TYPE=4
+	I TYPE="MEC"!(TYPE="MFC") S TYPE=5
+	S $P(TAB(1),D,4)=TYPE
+	; Wissel
+	S $P(TAB(1),D,5)=$S(CODE["-":1,1:0)
+	; +10 dagen na einde decode
+	S $P(TAB(1),D,6)=$S(CODE["+":1,1:0)
+	; Code
+	S $P(TAB(1),D)=$$TERM^cAFO10(Q,"",TAB(1),$P($G(@("^"_Q_"BA(39)")),D,2))
+	; Invullen omschrijvingen
+	S $P(TAB(1),D,2)=$$TERM^cAFO10(Q,"",TAB(1),"")
+	S $P(TAB(1),D,12)=$$TERM^cAFO10(Q,"",TAB(1),"F")
+	S $P(TAB(1),D,22)=$$TERM^cAFO10(Q,"",TAB(1),"D")
+	S $P(TAB(1),D,32)=$$TERM^cAFO10(Q,"",TAB(1),"E")
+	S $P(TAB(1),D,49)=$$Q49^cAFVBA03(Q,DMS)
+	D P^cAN220(DMS,"","","TAB","") I K="-" X "STOP"
+CODEBETZ	Q
+	;
+DCTR(K)	; datum
+	N R S R=0
+	I K?2N1"."2N1"."2N&$E(K,1,2)&$E(K,4,5)&($E(K,1,2)<32)&($E(K,4,5)<13)&'("04060911"[$E(K,4,5)&($E(K,1,2)=31))&'(+$E(K,4,5)=2&(('($E(K,7,8)#4)&($E(K,1,2)>29))!($E(K,7,8)#4&($E(K,1,2)>28))))!("-,"[K) S R=1
+	Q R
+	;
+JJJJMM(K)	         ; geldige maand
+	N R S R=0
+	I K?4n1"."2n,K\1>1979,K\1<2050,K#1,K#1<.13 S R=1
+	Q R
+	;
+KO(UQC,USC,UI1)	   ; test geldige kode
+	N UREF,R,RI,UDD
+	S UI1=$$DP^cAFA1($$UC^cAFA1(UI1))_" "
+	S R=0 I $L(UQC),$L(USC),$D(^DMC(UQC,USC)) D
+	. S UREF=^DMC(UQC,USC,"DATA","REF"),R=$D(@UREF) I R S K=$P(UI1," ")
+	Q R
+	;
+BP(K,VM)	; kontrole basisprijs van de aankoopgegevens produkten       *** BG ***
+	n DEC,R
+	s DEC=$$DEC^cAFA1(VM)
+	i VM=$P(@("^"_Q_"BA(39)"),D),$D(@("^"_Q_"PR(0,19)")) s DEC=$P(^(19),D,22)
+	s R=0 i @("K?.N!(K?.N1"".""."_DEC_"N)&DEC") s R=1
+	q R
+	;
+UM(DMS,I1,I2,MU)	   ; testen van bestaand multiple van 2 indexen      *** BG ***
+	N I,IREF,R,UQC,USC
+	D DMS^cAN000("UQC","USC",DMS)
+	S R=0 I $L(UQC),$L(USC),$D(^DMC(UQC,USC,"DATA")) D
+	. S IREF=$G(^("DATA","INDEX"))
+	. S I1=$P($$DI^cAN000(I1,"")," "),I2=$$DI^cAN000(I2,"")
+	. I $L(MU),$L(I1) S I=$O(@IREF@(MU,I1,I2)) I $E(I,1,$L(I2))=I2 S R=1
+	Q R
+	;
+R0	S $P(R,D,12)=$T(+0) D ^cAN1000 Q  ; v12 23.01.95
+	;
+ZZ	; 19.03.07 - 15 u 31 * V8.08
\ No newline at end of file