cAN1010	;Selectie item (barcode) ;%AN101 ; [ 01/04/01  8:18 AM ]
	G 1
	;
T0	;Selectie item ;
	;
T0F	;Sélection sujet ;
	;
T0E	;Selection item ;
	;
	; input RSI(1)   output : RSUI1 ingeval data barcode
1	I '$G(RSBAR) G YZ
	I '$L(RSI(1)) G YZ
	S $ZT="TRAP^cAN000"
	N RSD,RSJ,I,J,II,JJ,RSL,RIND2
	K RSUI1 S RIND2=0
	I $E(RSI(1),1,5)=99999,RSI(1)?13N,$$CC(RSI(1)) N UI1 S UI1=+$E(RSI(1),6,12) I UI1,$D(@RSREF) S RSUI1=UI1 G YZ
11	S RSJ(1)=$$DP^cAFA1($$UC^cAFA1(RSI(1)))
	D IND^cAN1011("BAR")  ; KU : 20.02.07
	; S RSD=$NA(@RSQ2@("BAR"))
	; bestaat barcode ?
	I '$G(RIND2) S I=$O(@RSD@(RSJ(1)_" ")) I $P(I," ")'=$P(RSJ(1)," ")!'$L(I) G YZ
	I $G(RIND2) I '$D(@RSD@(RSJ(1))) G YZ  ; KU : 20.02.07
	; uniek ?
	I '$G(RIND2) S J=$O(@RSD@(RSJ(1)_" ~"),-1)
	I $G(RIND2) S I=$O(@RSD@(RSJ(1),"")),J=$O(@RSD@(RSJ(1),""),-1)  ; KU : 20.02.07
	I I=J S RSUI1=^(I) S J(0)=RSUI1 K:'$$S3^cAN1011 RSUI1 G YZ
	; meerdere ?
	W /WSCROFF,/CUP(3,1),/WCMD
	I $L($G(RSM(1,"X"))) S RSJ(1)=RSJ(1)_" "
15	S J=$S($E(RSI(1))="*":"",1:RSJ(1))_" "
	S II=1,JJ=$P(QW(QW),D,3)-($P(QW(QW),D,5)*2)-2,RK=0
16	K RSL I $L($G(RSX)) D
	. N R,UI1
	. I RSDD=1 S UI1=$G(@$G(^DMC(UQC,USC,"DATA","OUD"))@(RSX))
	. I RSDD=2 S UI1=RSX_" "
	. I RSDD>2 S UI1=RSX
	. I $L(UI1) S I=RSM(1,"B") D
	.. I I,$P(I,D,2)="" S R=$P($G(@RSREF@(I\100-1)),D,I#100) Q
	. S J=$$DI^cAN000($G(R),RSX),RSX=$P(J," ",2)  ; KU : 20.02.07
	. I $L($G(RSM(1,"X"))) S J=J_"~",RSJ(1)=""
	. I $D(RIND2) S J(0)=$P(J," ",2),J=$P(J," "),RSL=""  ; KU : 20.02.07
	. F I=1:1:JJ\2+1 D S1^cAN1011(J,-1) Q:J=0
17	S I=0 F  Q:I=JJ  D S1^cAN1011(J,1) Q:J=""  I $$S3^cAN1011 S I=I+1 S RSL(I)=J,RSL(I,0)=J(0) D S2^cAN1011 I J(0)=$G(RSX) S II=I  ; KU : 20.02.07
	I I=0 G YZ
19	I I=1,'RSCONF,'$L($G(RSX)) S RK=28 G 3
	;
	; scroll met balk
2	S RSV=RK D BALK^cAN1011(7) K REFRESH
21	D ^cAFA0(RK,0,0,0,0,"23\24\25\26\31\32\70\84"_RSKEYS,0,0,0)
	;
3	; speciale funkties
320	I $D(^DMC(UQC,USC,"SYN",0,0,RK)) G Y:$D(^(RK,0)) I $D(^(1)) X ^(1) G 2:$G(REFRESH),Y
323	I RK=23 D  G 2                                              ; Home
	. I '$D(RSL(1)) D BEL Q
	. D BALK^cAN1011(0) S II=1 I '$D(RSL(JJ)) Q
	. K RSL W /CUP(3,1),/WCMD
	. S I=0,J=$S($E(RSI(1))="*":"",1:RSJ(1))_" " F  Q:I=JJ  D S1^cAN1011(J,1) Q:J=""  I $$S3^cAN1011 S I=I+1 D
	.. S RSL(I)=J,RSL(I,0)=J(0)
	. F I=JJ:-1:1 I $D(RSL(I)) D S2^cAN1011 S II=I
324	I RK=24 D  G 2                                              ; End
	. I '$D(RSL(1)) D BEL Q
	. D BALK^cAN1011(0) S II=$O(RSL(""),-1) I '$D(RSL(JJ)) Q
	. K RSL W /CUP(3,1),/WCMD
	. S I=0,J=$S($E(RSI(1))="*":"",1:RSJ(1))_"~" F  Q:I=JJ  D S1^cAN1011(J,-1) Q:J=0  I $$S3^cAN1011 S I=I+1 D
	.. F II=I:-1:2 M RSL(II)=RSL(II-1) K RSL(II-1)
	.. S RSL(1)=J,RSL(1,0)=J(0)
	. F I=1:1:JJ I $D(RSL(I)) D S2^cAN1011 S II=I
325	I RK=25 D  G 2                                              ; PgUp
	. I '$D(RSL(1)) D BEL Q
	. D BALK^cAN1011(0) I II=1 S RSV=RK
	. S II=1 I RK'=RSV!'$D(RSL(JJ)) Q
	. S I=1,J=RSL(1) F  Q:I=JJ  D S1^cAN1011(J,-1) Q:J=0  I $$S3^cAN1011 S I=I+1 D
	.. F II=JJ:-1:2 K RSL(II) M RSL(II)=RSL(II-1)
	.. K RSL(1) S RSL(1)=J,RSL(1,0)=J(0)
	. F I=JJ:-1:1 D S2^cAN1011 S II=I
326	I RK=26 D  G 2                                              ; PgDn
	. I '$D(RSL(1)) D BEL Q
	. D BALK^cAN1011(0) I II=JJ S RSV=RK
	. S II=$O(RSL(""),-1) I RK'=RSV!'$D(RSL(JJ)) Q
	. S I=1,J=RSL(JJ) F  Q:I=JJ  D S1^cAN1011(J,1) Q:J=""  I $$S3^cAN1011 S I=I+1 D
	.. F II=1:1:JJ-1 K RSL(II) M RSL(II)=RSL(II+1)
	.. K RSL(JJ) S RSL(JJ)=J,RSL(JJ,0)=J(0)
	. F I=1:1:JJ D S2^cAN1011 S II=I
327	I RK=27 G Y                                                 ; Esc
328	I RK=28 S K=$G(RSL(II,0)) S:K="" RK=29 S RSUI1=K G Y        ; Enter
329	I RK=29 G Y                                                 ; Tab
331	I RK=31 D  G 2                                              ; Pijl ^
	. I '$D(RSL(1)) D BEL Q
	. D BALK^cAN1011(0)
	. I II>1 S II=II-1 Q
	. S I=0,J=RSL(1) F  Q:I  D S1^cAN1011(J,-1) Q:J=0  I $$S3^cAN1011 D
	.. F II=JJ:-1:2 I $D(RSL(II-1)) M RSL(II)=RSL(II-1)
	.. S RSL(1)=J,RSL(1,0)=J(0)
	.. F I=JJ:-1:1 I $D(RSL(I)) D S2^cAN1011 S II=I
332	I RK=32 D  G 2                                              ; Pijl v
	. I '$D(RSL(1)) D BEL Q
	. D BALK^cAN1011(0)
	. I II<$O(RSL(""),-1) S II=II+1 Q
	. I $D(RSL(JJ)) S I=0,J=RSL(JJ) F  Q:I  D S1^cAN1011(J,1) Q:J=""  I $$S3^cAN1011 D
	.. F II=1:1:JJ-1 M RSL(II)=RSL(II+1)
	.. S RSL(JJ)=J,RSL(JJ,0)=J(0)
	.. F I=1:1:JJ D S2^cAN1011 S II=I
370	I RK=70 D  G 2                                              ; ^F
	. I '$D(RSL(1))!'RSCONF(RK) D BEL Q
	. N UQA,USA,UQM,UI1
	. S (UQA,USA)="",UQM=0,UI1=RSL(II,0)
	. I $D(^DMS(0,RSDMS,0)) S UQA=$P(^(0),D,3),USA=$P(^(0),D,4)
	. I $D(^DMS(Q,RSDMS,0)) S UQA=$P(^(0),D,3),USA=$P(^(0),D,4)
	. S:UQA="" UQA=0 S:USA="" USA=RSDMS
	. D ^cA338,R^cAN200(USA,UQA,"",UQM,$$IDEM^cAFA1),^cA339
384	I RK=84 D  G 2                                              ; ^T
	. I '$D(RSL(1)) D BEL Q
	. N TXTUI1,TXTUQC,TXTUSC,R
	. S (R,TXTUI1)=RSL(II,0) I RSDD<3 S R=$P(R," ",3-RSDD)
	. I '$D(^DMC(UQC,USC,"DATA","TXT"))!'$L(R) D BEL Q
	. S TXTUQC=UQC,TXTUSC=USC,R=$NA(@^("TXT")@(R),3)
	. D RT^cAN210("TXT",0,0,0,R)
	;
39	D BEL G 21
	;
Y	D BALK^cAN1011(0) K RSD,RSL,RSX
YZ	Q
	;
CC(R,CC)	; test EAN13 -code
	; 0 = slecht, 1 = goed
	; CC = 1 : geef enkel controlecijfer terug
	N R1,R2,R3
	S R=$RE($TR(R," ()",""))    ; alle tekens eruit en omdraaien
	I $G(CC) S R=" "_R
	S (R1,R2)=0
	f i=2:2:12 s R1=R1+$E(R,i)
	S R1=R1*3
	F i=3:2:13 S R2=R2+$E(R,i)
	S R3=R1+R2,R3=10-(R3#10) S:R3=10 R3=0
	I '$G(CC) S R3=$E(R)=R3
CCZ	Q R3
	;
BEL	W $C(7) Q     
	;
ZZ	; 29.08.07 - 10 u 22 * V8.09