cTU60 ;UITVOERING SELECTIES ;%TU6 ;do uit %TU6 ; [ 08/19/94  4:09 PM ]
 S UNIEK=0 G 3
 ;
S1 D S3
S1A I S2#10=7 S OK=$E(S1,1,$L(S3))=S3 S:S2\10 OK='OK G S1Z
S1B I S2#10=8 S OK=S1[S3 S:S2\10 OK='OK G S1Z
S1C I S2#10=9 S OK=$E(S1,$L(S1)-$L(S3)+1,999)=S3 S:S2\10 OK='OK G S1Z
S1D I S4,$L(S1)=8,$L(S3)=8 S S1=$E(S1,7,8)<50+19_$E(S1,7,8)_$E(S1,4,5)_$E(S1,1,2),S3=$E(S3,7,8)<50+19_$E(S3,7,8)_$E(S3,4,5)_$E(S3,1,2)
S1E S S2=$P(">\'<\=\<\'>\'=\",D,S2),OK=S2_"S3"
S1F I S1'?.1"-".N.1".".N!(S3'?.1"-".N.1".".N) S:S2="<" OK="']S3&(S3'=S1)" S:S2=">" OK="]S3&(S3'=S1)" S:S2="'>" OK="']S3!(S3=S1)" S:S2="'<" OK="]S3!(S3=S1)"
S1G S OK="S OK=S1"_OK X OK
S1Z Q
 ;
S2 S S2=S1,S1="" F S3=1:1:$L(S2) S S4=$E(S2,S3) S:S4?1L S4=$C($A(S4)-32) S:S4'?1P S1=S1_S4
S2Z Q
 ;
S3 I S1 S S1=$P(K,D,S1#100) Q
S3Z S U3="" X S1 S S1=U3 Q
 ;
S4 I '$L($P(K,U,5)) S J1=I1,S1=$P(K,U,3),S4=$P(K,U,4),K=D S:$D(B(S1\100)) K=B(S1\100) Q
S4A X $P(K,U,6) S S1=$P(K,U,7),S4=$P(K,U,8) I '$L(J1) S K=D Q
S4Z S R="" S:$D(@("^"_Q_$P(K,U,5)_"(J1,S1\100-1)")) R=^(S1\100-1) S K=R Q
 ;
S5 I S4,$L(S1)=8 S S1=$E(S1,7,8)<50+19_$E(S1,7,8)_$E(S1,4,5)_$E(S1,1,2)
S5A I S1'?.1"-".N.1".".N D S2
S5B S:S1="" S1=" " S J=J_""""_S1_""","
S5Z Q
 ;
3 X NXT G 5:I1=-1!(I1=""),3:'$D(@("^"_Q_Q1_"(I1,0)"))
31 K B S T=T+1,I=0,B(1)=^(I),X1=100 W:QP @F,$TR($P(B(1),D,1,2),D," "),@F1
32 S I=$O(^(I)) I I?1.2N S B(I+1)=^(I) G 32
33 S X2=X1,X1=$O(@("^"_Q_"LIS(I2,X1)")) G 4:X1\100'=(X2\100) S K=^(X1)
34 S S2=$P(K,U),S3=$P(K,U,2),K=$P(K,U,3,99) D S4,S1 
35 G 33:OK S X1=X1\100+1*100 G 3:$O(@("^"_Q_"LIS(I2,X1)"))="",33
39 S:$D(SWKL)&$D(SWLE) J="^HULP($J," G 41:$D(SWKL)&$D(SWLE),3
 ;
4 K SWKL,SWLE,SWK,SWL,K4,K8 S J="^HULP($J,"
41 I AS F X1=1:1:AS S K=A(X1) D S4,S3,S5
43 S UNIEK=UNIEK+1,J=J_UNIEK_")",@J=I1,J="" G 39
 ;
5 B 0 S K1=T,(S1,S2,S3,S4,S5,S6)="",T=0,@%Q1=0 K @("^"_Q_"LIH(NR)")
51 S S1=$O(^HULP($J,S1)) G 7:S1="" I $D(^(S1))#10 S K=S1 D 6 G 51
52 S S2=$O(^HULP($J,S1,S2)) G 51:S2="" I $D(^(S2))#10 S K=S2 D 6 G 52
53 S S3=$O(^HULP($J,S1,S2,S3)) G 52:S3="" I $D(^(S3))#10 S K=S3 D 6 G 53
54 S S4=$O(^HULP($J,S1,S2,S3,S4)) G 53:S4="" I $D(^(S4))#10 S K=S4 D 6 G 54
55 S S5=$O(^HULP($J,S1,S2,S3,S4,S5)) G 54:S5="" I $D(^(S5))#10 S K=S5 D 6 G 55
56 S S6=$O(^HULP($J,S1,S2,S3,S4,S5,S6)) G 55:S6="" S K=S6 D 6 G 56
 ;
6 S K=^(K),T=T+1,@("^"_Q_"LIH(NR,T)")=K Q
 ;
7 S K=$H
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 21.09.94 - 11 u 43 * V5.5