KTRA3 G YZ ;TRANSFERT BESTANDEN ;KTRA1; Overlay van KTRA2 [ 08/06/2002   8:39 AM ]
 ;
SC S PCC=$$COMPR^PRODUKT(PR)
 Q
 ;
S0 S HG=-1
S0A S HG=$N(@("^"_Q_"HULP($J,HG)")) G S0Z:HG=-1 S GR=-1
S0B S GR=$N(@("^"_Q_"HULP($J,HG,GR)")) G S0A:GR=-1 S SG=-1
S0C S SG=$N(@("^"_Q_"HULP($J,HG,GR,SG)")) G S0B:SG=-1 S PCC=-1
S0D S PCC=$N(@("^"_Q_"HULP($J,HG,GR,SG,PCC)")) G S0C:PCC=-1 S I=-1
S0E S I=$N(@("^"_Q_"HULP($J,HG,GR,SG,PCC,I)")) G S0D:I=-1 S K=^(I) W $C(13),K S K="" G S0E
S0Z K HG,GR,SG,PCC,PR,ID,R,I,@("^"_Q_"HULP($J)") Q
 ;
S1 K B S B(1)=@("^"_Q_"PR(PR,0)") F I=1:1:9 I $D(^(I)) S B(I+1)=^(I)
S1A S (B("I"),B("J"))="",I=$N(^("I")) S:$E(I,1)="I" B("I")=^(I) S I=$N(^("J")) S:$E(I,1)="J" B("J")=^(I)
S1B F I=325,101,102,111 S K=K_$P(B(I\100),D,I#100)_D
S1C S K=K_$P("Y\N",D,$P(B(2),D,25)+1)_D F I=1:1:3 S K=K_$P(B("I"),D,I)_D
S1D F I=1,19,26 S K=K_$P(B("J"),D,I)_D
S1E W !,K S K=""
S1Z K I Q
 ;
S2 G S2Z:'$D(@("^"_Q_"STPR(PR)")) S ID=$P(@("^"_Q_"PR(PR,2)"),D,25),KC=0
S2A S KC=$N(@("^"_Q_"STPR(PR,KC)")) G S2Z:KC=-1
S2B S R=@("^"_Q_"STPR(PR,KC,0)"),I=DJ-1_".00 " G S2A:$N(^(I))=-1 S K=K_ID_","_KC_","_$P(R,D,1)_","_$P(R,D,2)_",",R=0
S2C S I=$N(^(I)) I I'=-1 S R=R+$P(^(I),D,1) G S2C
S2D S K=K_R_"," W $C(13),K S K="" G S2A
S2Z K KC,R,I,ID Q
 ;
S3 G S3Z:'$D(@("^"_Q_"STPR(PR)")) S R=$P(@("^"_Q_"PR(PR,2)"),D,25)
S3A S I=@("^"_Q_"STPR(PR,0,0)"),I=DJ-1_".00 " G S3Z:$N(^(I))=-1
S3B S I=$N(^(I)) I I'=-1 S X=^(I),K=K_R_","_$E(I,3,7)_","_$P(X,D,1)_","_$P(X,D,2)_","_$P(X,D,3)_","_$P(X,D,4)_","_$P(X,D,5)_"," W $C(13),K S K="" G S3B
S3Z K R,I Q
 ;
S4 G S4Z:'$D(@("^"_Q_"STPR(PR)")) S R=$P(@("^"_Q_"PR(PR,2)"),D,25),KC=0
S4A S KC=$N(@("^"_Q_"STPR(PR,KC)")) G S4Z:KC=-1 S I=^(KC,0),I=DJ-1_".00 " G S4A:$N(^(I))=-1
S4B S I=$N(^(I)) I I'=-1 S X=^(I),K=K_R_","_KC_","_$E(I,3,7)_","_$P(X,D,1)_","_$P(X,D,2)_","_$P(X,D,3)_","_$P(X,D,4)_","_$P(X,D,5)_"," W $C(13),K S K="" G S4B
S4C G S4A
S4Z K KC,R,I Q
 ;
S5 S KC=0
S5A K B S KC=$N(@("^"_Q_"K1(KC)")) G S5Z:KC=-1 S KI1=^(KC),B(1)=@("^"_Q_"KL(KI1,0)") F I=1:1:9 I $D(^(I)) S B(I+1)=^(I)
S5B F I=1:1:7 S K=K_$P(B(1),D,I)_D
S5C S R=$P(B(1),D,8),R=$$LAND^vhRtn1(R,2),K=K_R_D_$P(B(1),D,9)_D
S5D F I=13,14,16 S K=K_$P(B(1),D,I)_D
S5E W !,K S K="" F I=225,214,111 S K=K_$P(B(I\100),D,I#100)_D
S5F S K=K_$P("Y\N",D,$P(B(3),D,10)+1)_D_$P("N\Y",D,$P(B(2),D,15)+1)_D_$P(B(3),D,3)
S5G S:$D(^KLPUTZ("N",$P(B(1),D,1))) K=K_"+" S K=K_D F I=311,312,404 S K=K_$P(B(I\100),D,I#100)_D
S5H S K=K_$P("N\Y",D,$P(B(1),D,19)+1)_D_$P(B(4),D,3)_D,R=D G S5M:'$D(@("^"_Q_"STKL($P(B(1),D,1))"))
S5I S R=0,I=$N(^($P(B(1),D,1),0,0)),I=DJ-1_".00 "
S5J S I=$N(^(I)) I $P(I,".",1)=(DJ-1) S R=R+$P(^(I),D,3) G S5J
S5K S:R=0 R="" S K=K_R_D,R=0,I=DJ_".00 "
S5L S I=$N(^(I)) I $P(I,".",1)=DJ S R=R+$P(^(I),D,3) G S5L
S5M S:R=0 R="" S K=K_R_D S:$D(@("^"_Q_"SEKT($P(B(1),D,20)_"" "")")) K=K_^($P(B(1),D,20)_" ") S K=K_D_$P(KI1," ",1)_D W K S K=""
S5N G S5A
S5Z K KC,KI1,I Q
 ;
S6 S KC=0
S6A S KC=$N(@("^"_Q_"STKL(KC)")) G S6Z:KC=-1 S PR=0 K @("^"_Q_"HULP($J)")
S6B S PR=$N(@("^"_Q_"STKL(KC,PR)")) G S6H:PR=-1,S6B:'$L($P(^(PR,0),D,1)),S6B:'$D(@("^"_Q_"PR(PR)"))
S6C S PC=$P(^(PR,0),D,1),ID=$P(^(2),D,25),I=" \ \ " S:$E($N(^("I")),1)="I" I=^($N(^("I")))
S6D S HG=$P(I,D,1)_" ",GR=$P(I,D,2)_" ",SG=$P(I,D,3)_" " D SC
S6E S R=@("^"_Q_"STKL(KC,PR,0)"),I=DJ-1_".00 " G S6B:$N(^(I))=-1 S K=K_KC_","_ID_","_$P(R,D,1)_","_$P(R,D,2)_",",R=0
S6F S I=$N(^(I)) I I'=-1 S R=R+$P(^(I),D,1) G S6F
S6G S K=K_R_",",@("^"_Q_"HULP($J,HG,GR,SG,PCC,0)")=K,K="" G S6B
S6H D S0 G S6A
S6Z K KC Q
 ;
S7 S KC=0
S7A S KC=$N(@("^"_Q_"STKL(KC)")) G S7Z:KC=-1,S7A:'$L($P(^(KC,0,0),D,1)) S I=DJ-1_".00 " G S7A:$N(^(I))=-1
S7B S I=$N(^(I)) I I'=-1 S X=^(I),K=K_KC_","_$E(I,3,7)_","_$P(X,D,1)_","_$P(X,D,2)_","_$P(X,D,3)_","_$P(X,D,4)_","_$P(X,D,5)_"," W $C(13),K S K="" G S7B
S7C G S7A
S7Z K KC,I Q
 ;
S8 S KC=0
S8A S KC=$N(@("^"_Q_"STKL(KC)")) G S8Z:KC=-1 S PR=0 K @("^"_Q_"HULP($J)")
S8B S PR=$N(@("^"_Q_"STKL(KC,PR)")) G S8H:PR=-1,S8B:'$L($P(^(PR,0),D,1)),S8B:'$D(@("^"_Q_"PR(PR)"))
S8C S PC=$P(^(PR,0),D,1),ID=$P(^(2),D,25),I=" \ \ " S:$E($N(^("I")),1)="I" I=^($N(^("I")))
S8D S HG=$P(I,D,1)_" ",GR=$P(I,D,2)_" ",SG=$P(I,D,3)_" " D SC S I=DJ-1_".00 "
S8E S I=$N(@("^"_Q_"STKL(KC,PR,I)"))
S8F I I'=-1 S X=^(I),K=K_KC_","_ID_","_$E(I,3,7)_","_$P(X,D,1)_","_$P(X,D,2)_","_$P(X,D,3)_","_$P(X,D,4)_","_$P(X,D,5)_",",@("^"_Q_"HULP($J,HG,GR,SG,PCC,I)")=K,K="" G S8E
S8G G S8B
S8H D S0 G S8A
S8Z K KC Q
 ;
S9 S KC=0
S9A S KC=$N(@("^"_Q_"K1(KC)")) G S9Z:KC=-1 S KI1=^(KC),KI2="L"
S9B S KI2=$N(@("^"_Q_"KL(KI1,KI2)")) G S9A:$E(KI2,1)'="L" S R=^(KI2),I=$P(R,D,19)
S9C I I'=".",$D(@("^"_Q_"K1(I)")) S R=$P(R,D,1)_D_$P(@("^"_Q_"KL(^(I),0)"),D,2,13)_D_$P(R,D,14,99)
S9D S K=K_KC_D_$P(R,D,1)_D F I=5:1:7 S K=K_$P(R,D,I)_D
S9E S I=$P(R,D,8),I=$$LAND^vhRtn1(I,2),K=K_I_D_$P(R,D,9)_D F I=13,24,25 S K=K_$P(R,D,I)_D
S9F W !,K S K="" G S9B
S9Z K KC,R,I Q
 ;
S10 S KC=0
S10A S KC=$N(^KLPUTZ("N",KC)) G S10Z:KC=-1 S HG=-1
S10B S (HG,HGR)=$N(^KLPUTZ("N",KC,HG)) G S10A:HG=-1 S GR=-1 S:HG=0 HGR=""
S10C S (GR,GRR)=$N(^KLPUTZ("N",KC,HG,GR)) G S10B:GR=-1 S SG=-1 S:GR=0 GRR=""
S10D S (SG,SGR)=$N(^KLPUTZ("N",KC,HG,GR,SG)) G S10C:SG=-1 S PR=-1 S:SG=0 SGR=""
S10E S PR=$N(^KLPUTZ("N",KC,HG,GR,SG,PR)) G S10D:PR=-1 S NXT=-1
S10F S NXT=$N(^KLPUTZ("N",KC,HG,GR,SG,PR,NXT)) G S10E:NXT=-1
S10G S R=D_$P(^(NXT),D,1,3) I PR,$D(@("^"_Q_"PR(PR)")) S R=$P(^(PR,2),D,25)_R
S10H S K=K_KC_","_HGR_","_GRR_","_SGR_","_$P(R,D,1)_"," S:$P(R,D,2) K=K_$J($P(R,D,2),0,1) S K=K_","
S10I S:$P(R,D,3) K=K_$J($P(R,D,3),0,1) S K=K_","_$P(R,D,4)_"," W $C(13),K S K="" G S10E
S10Z K KC,HG,HGR,GR,GRR,SG,SGR,PR,R,NXT Q
 ;
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 05.08.87 - 14 u 37