cTU25 ;OPMAKEN BESTAND ;%TU24 ; [ 04/09/96  9:23 AM ]
 G 1
 ;
S3 I S1 S S1=$P(K,D,S1#100) Q
S3Z S U3="" X S1 S S1=U3 Q
 ;
S6 S K=0,L=L+1 F I=1:1:RT S K=K+RL(I)
S6A I K<MRL S RT=RT+1,RL(RT)=MRL-K,RT(RT)=""
S6B S RS=SEP D ^cA700 W $J(L,15),*13
S6Z K RL,RT S RT=0 Q
 ;
1 B 1 S NM2=@("^"_Q_"BA(99,2)"),NM3=^(3),T=0,FP=2001 W @F,@F1 S SEP=RS
12 S L=0,I1=0,K1=0 I PP(3)'=0 S (I1,K1,K)=PP(3) X $P(SN,U,2):$L($P(SN,U,2)) S I1=K G 22
 ;
2 I NR S K1=$O(@("^"_Q_"LIH(NR,K1)")) G 5:K1="" S I1=^(K1) S:Q1="PR" PR=I1 G 22
20 I $L($P(SN,U,3)) X $P(SN,U,3) G 5:I1=-1,22
21 S I1=$O(@("^"_Q_Q1_"(I1)")) G 5:I1=""!(I1]I1X)
22 G 2:'$D(@("^"_Q_Q1_"(I1,0)")) S K=-1
23 S K=$O(^(K)) I $L(K),K<99&(K?.N) S B(K+1)=^(K) G 23
24 S:PP(5) $P(^(13),D,1,3)=PP(5)_D_PP(6)_D_PP(7)
25 S (I2,J,T)=0,RT=0
 ;
3 S I2X=I2,I2=$O(@("^"_Q_"LIL(J2,I2)")) G 6:I2="" I I2X,I2X\100'=(I2\100) D S6
31 S I=@("^"_Q_"LIL(J2,I2)")
32 S U3="",R=$P(I,U,6) I $L(R) X $P(I,U,7) G 35:J1="" S S1=$P(I,U,4),K=D S:$D(@("^"_Q_R_"(J1,S1\100-1)")) K=^(S1\100-1) D S3 S (U3,K)=S1 G 35
33 S J1=I1,S1=$P(I,U,4),K=D S:$D(B(S1\100)) K=B(S1\100) D S3 S (U3,K)=S1
35 I $L($P(I,U,3)) S K=U3 X "S U3="_$P(I,U,3)
39 I $P(I,U,8) S T=T+1 S:'$D(T(T)) T(T)=0 S T(T)=T(T)+U3
 ;
4 I $P(I,U,8),'$L($P(I,U,5)) S $P(I,U,5)=0
41 I $L($P(I,U,5)) X "S U3=$J(U3,"_$P(I,U)_","_$P(I,U,5)_")" G 45
43 E  S U3=$E(U3,1,$P(I,U))
45 S RT=RT+1,RT(RT)=U3,RL(RT)=$P(I,U) G 3
 ;
5 G ^cA702
 ;
6 D S6 G 24:$D(SWKL)!$D(SWLE) S (K5,K9)="" G 2
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 14.01.99 - 21 u 28 * V5.7