cTA806	;AN. VERR. - REGISTRATIE ;%TA80 ; [ 01/02/01  6:00 PM ]
	G 1
	;
T0	;An. verr. - registratie ;
	;
T0F	;Op. an. - enregistrement ;
	;
T0E	;An. trans. - registration ;
	;
S1	S X=D,$P(X,D,23)=D F S1=BJ:.01:BJ+.02 I '$D(^(S1)) S ^(S1)=X
S1A	F X=0,1 I BC(X) S S1=X*.02+BJ,$P(^(S1),D,BX)=$P(^(S1),D,BX)+BC(X)
S1B	S BH=BH\1 D:BPE @BPEC I HIS S S1="E"_RB_"#"_BNR_D G S1D
S1C	S S1=BH_"E"_RB,S2=$S($D(^(S1)):^(S1),1:D),^(S1)=NUM_D_DAT_D_($P(S2,D,3)+BC(0))_D_($P(S2,D,4)+BC(1))_D_$P(S2,D,5,99) G S1Z
S1D	S BH=BH+.01 S:BH#1=0 HIS=0,BH=BH-1 D ^cT00:'HIS G S1C:'HIS,S1D:$D(^(BH+.01)) S:'$D(^(BH)) ^(BH)=""
S1E	I ^(BH)'[S1 G S1D:$L(^(BH))+$L(S1)>255 S ^(BH)=^(BH)_S1
S1Z	K S1,S2 S (BC(0),BC(1))=0 Q
	;
S2	L +@("^"_Q_G_"(I1)"):2 E  S R=14 D F2 G S2
S2A	S RR5=$E(I2,2,8),HIS=1,S1=$D(@("^"_Q_G_"(I1,0)")) D S4
S2Z	K RR5 Q
	;
S4	S S3=2_$E(RR5_$J("",7),1,7)_(BP*100),S4=0 I HIS S S1="E"_RB_"#"_BNR_D G S4B
S4A	S S1=S3_"E"_RB,S2=$S($D(^(S1)):^(S1),1:D),^(S1)=NUM_D_DAT_D_($P(S2,D,3)+BC(0))_D_($P(S2,D,4)+BC(1))_D_$P(S2,D,5,99) G S4Z
S4B	S S4=S4+.01,S2=S3_S4 S:S4=1 HIS=0 D ^cTA00:'HIS G S4A:'HIS,S4B:$D(^(S3_(S4+.01))) S:'$D(^(S2)) ^(S2)=""
S4C	I ^(S2)'[S1 G S4B:$L(^(S2))+$L(S1)>255 S ^(S2)=^(S2)_S1
S4Z	K S1,S2,S3,S4 Q
	;
	; Van
1	S CO="D",BE=HBE,BC(0)=BE,BC(1)=0 S:BE<0 CO="C",BE=-BE,BC(0)=0,BC(1)=BE
11	S K=$T(+0)_D_DAT_D_NUM_D_CD_D_BE_D_CO_D_"A"_D_$P(BR," ")_"#"_NMA_D_OM_D_BPE_D
13	S K=K_BE_D_D_D_SRT_D_OM1_D_BR1_D_D_D_D_HBE_D_HBE_D_D_HBF_D_HBF_D_BE_D_PAR_D_D_$H_D_$G(QU)_D_D
	;GM 07.04.04 Eventueel 4 IAS-velden wegschrijven
	I $P($G(@("^"_Q_"BA(300)")),D,8) S $P(K,D,31,34)=BR1_D_$$SEG^cTA901(BR1)
15	L @Q93 S BNR="",BNR=$O(@("^"_Q_"FIE(BP,RB,BNR)"),-1)+1,^(BNR)=K D S6^cTA809
	;
2	S G="AR",I1=BR,I2=2_$E(BR1_$J("",7),1,7)_(BP*100),X="E"_RB_"#"_BNR_D D S2
21	S G="ARA",I1=BR1,I2=2_$E(BR_$J("",7),1,7)_(BP*100),X="E"_RB_"#"_BNR_D D S2
23	S HIS=1 D S1
	;
	; GM 21.05.04 Extra cumuls
	D ECUM^cTA180("FIE",BP,RB,BNR)
	;
	; Naar
3	S CO="D",BE=HBE2,BC(0)=BE,BC(1)=0 S:BE<0 CO="C",BE=-BE,BC(0)=0,BC(1)=BE
31	S K=$T(+0)_D_DAT_D_NUM_D_CD_D_BE_D_CO_D_"A"_D_$P(BR," ")_"#"_NMA_D_OM_D_BPE_D
33	S K=K_BE_D_D_D_SRT_D_OM1_D_BR2_D_D_D_D_(HBE+HBE2)_D_(HBE+HBE2)_D_D_HBF_D_HBF_D_BE_D_PAR_D_D_$H_D_$G(QU)_D_D
	;GM 07.04.04 Eventueel 4 IAS-velden wegschrijven
	I $P($G(@("^"_Q_"BA(300)")),D,8) S $P(K,D,31,34)=BR2_D_$$SEG^cTA901(BR2)
35	L @Q93 S BNR="",BNR=$O(@("^"_Q_"FIE(BP,RB,BNR)"),-1)+1,^(BNR)=K D S6^cTA809
	;
4	S G="AR",I1=BR,I2=2_$E(BR2_$J("",7),1,7)_(BP*100),X="E"_RB_"#"_BNR_D D S2
41	S G="ARA",I1=BR2,I2=2_$E(BR_$J("",7),1,7)_(BP*100),X="E"_RB_"#"_BNR_D D S2
43	S HIS=1 D S1
	;
	; GM 21.05.04 Extra cumuls
	D ECUM^cTA180("FIE",BP,RB,BNR)
	;
	; Ronddraaien?
5	S K=HBE+HBE2 I K'=0 S ROND=1,HBE=K G 4^cTA805
	;
YZ	L @Q93 K B,BR,BR1,BR2 Q
	;
F1	S R=250
F2	D TXT^cAFA1(R)
FZ	K R Q
	;
Z	X ^cZ Q
ZZ	; 24.06.04 - 10 u 48 * V8