KT210 G 1 ;TRANSFERT LISTINGS ;KT209;Go uit KT209 [ 11/08/2003   8:42 PM ]
 ;
R3 S R1=$P(R,D,2),R2=$P(R,D,4),R0=$J($P(R,D,1),0,R2),R3=" ",R4="" S:R2 R4=","_$P(R0,".",2),R1=R1-1-R2 S:R0<0 R3="-",R0=-R0
R3A S R0=+$P(R0,".",1) F R5=3,7 S R6=$L(R0) G R3B:R6'>R5 S R0=$E(R0,1,R6-R5)_"."_$E(R0,R6-R5+1,R6)
R3B W ?$P(R,D,3),$J(R0,R1),R4,R3
R3Z K R0,R1,R2,R3,R4,R5,R6 Q  ;V1 26.11.84
 ;
S3 I S1 S S1=$P(K,D,S1#100) Q
S3Z S U3="" X S1 S S1=U3 Q
 ;
1 B 1
19 S LN=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=$N(@("^"_Q_"LIH(NR,K1)")) G YZ:K1=-1 S I1=^(K1) G 22
20 I $L($P(SN,U,3)) X $P(SN,U,3) G YZ:I1=-1,22
21 S I1=$N(@("^"_Q_Q1_"(I1)")) G YZ:I1=-1!(I1]I1X)
22 G 2:'$D(@("^"_Q_Q1_"(I1,0)")) S K=-1
23 S K=$N(^(K)) I K<99&(K?.N) S B(K+1)=^(K) G 23
24 D 8:'LN S (I2,J)=0
3 S I2=$N(@("^"_Q_"LIL(J2,I2)")) I I2=-1 W ! G 2
31 S I=^(I2) I I2\100'=J S J=I2\100
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,U3="S U3="_$P(I,U,3) X U3
 ;
4 S U3=$E(U3,1,I) I $L($P(I,U,5)) S U3=$TR($J(U3,0,$P(I,U,5)),".",",")
41 D WRITE(U3) S I2=$N(@("^"_Q_"LIL(J2,I2)")) I I2=-1 W ! G 2
43 W $C(9) G 31
 ;
8 F LN=1:1 Q:'$D(A(LN))  F EL=1:1 Q:'$L($P(A(LN),D,EL,99))  W $P(A(LN),D,EL) W:$L($P(A(LN),D,EL+1,99)) $C(9) I '$L($P(A(LN),D,EL+1,99)),$D(A(LN+1)) W $C(9)
81 W ! S LN=LN-1
85 Q
 ;
WRITE(R) 
 N I
 I R["""" D
 .F I=$L(R):-1:1 I $E(K,I)="""" S $E(K,I)=""""""
 .S R=""""_R_""""
 W $TR(R,FVAN,FNAAR)
 Q
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 26.03.91 -  9 u 21