KPFU2 G 1 ;FUSIE VAN PRODUKTEN ; KPFU1; Quit naar KPFU1 [ 05/24/2002  3:52 PM ]
 ;
S1 F I=1:1:9 I $L($P(T,D,I))!$L($P(K,D,I)) S $P(T,D,I)=$P(T,D,I)+$P(K,D,I)
S1Z Q
 ;
S2 N zr
 S T=$P(^(I3),D,1),zr=$ZR,T=$$INTDATE^vhLib.DataTypes(T)
 I $$INTDATE^vhLib.DataTypes($P(K,D,1))>T S @zr=K
S2Z Q
 ;
1 S @%Q1=0 K @("^"_Q_"HULP($J)") S R=0,@("^"_Q_"HULP($J,""BS"",0)")=0
11 S R=$N(PR(R)) G 4:R=-1 S K=@("^"_Q_"PR(R,0)") I $P(K,D,12) S ^(0)=@("^"_Q_"HULP($J,""BS"",0)")+$P(K,D,12)
13 S K=$P(K,D,13),K=$TR($$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes(K),"DS"),D,"")
 I K,K>20 S ^(K)=""
2 S I2="H"
21 S I2=$N(@("^"_Q_"PR(R,I2)")) G 3:$E(I2,1)'="H" S K=^(I2)
23 F T=1:1 S L=$P(K,D,T) Q:'$L(L)  S:'$D(@("^"_Q_"HULP($J,""H"",L)")) ^(L)=0 S ^(L)=^(L)+1
25 G 21
3 S I2="S"
31 S I2=$N(@("^"_Q_"PR(R,I2)")) G 11:$E(I2,1)'="S" S K=^(I2)
33 S L="" S:$D(@("^"_Q_"HULP($J,""S"",I2)")) L=^(I2) F T=1:1:9 I $L($P(K,D,T))!$L($P(L,D,T)) S $P(K,D,T)=$P(K,D,T)+$P(L,D,T)
35 S ^(I2)=K G 31
 ;
4 S T=@("^"_Q_"HULP($J,""BS"",0)"),L=$N(^(0)) S:L=-1 L=""
41 S:L L=$E(L,7,8)_"."_$E(L,5,6)_"."_$E(L,3,4) S K=@("^"_Q_"PR(PR,0)"),$P(K,D,12)=T,$P(K,D,13)=L,^(0)=K
43 S I2="H" K ^(I2)
45 S I2=$N(^(I2)) I $E(I2,1)="H" K ^(I2) G 45
47 S I2="S"
49 S I2=$N(^(I2)) I $E(I2,1)="S" K ^(I2) G 49
5 S (T,R,L)=0
51 S K=$N(@("^"_Q_"HULP($J,""H"",R)")),K="" G 53:L
52 S I=$N(^(R)) G 55:I=-1 S L=^(I)
53 I ($L(K)+$L(I)+1)<256 S R=I,K=K_R_D,L=L-1 G 53:L,52
55 I $L(K) S T=T+1,I2="H"_$E("0000",1,4-$L(T))_T,@("^"_Q_"PR(PR,I2)")=K
57 G 51:I'=-1 S:T @("^"_Q_"PR(PR,""H"")")=T S I="S"
59 S I=$N(@("^"_Q_"HULP($J,""S"",I)")) I $E(I,1)="S" S K=^(I),@("^"_Q_"PR(PR,I)")=K G 59
 ;
6 S R=0
61 S R=$N(PR(R)) G 7:R=-1,61:R=PR S K=@("^"_Q_"PR(R,2)"),PC=$P(K,D,25),PCC=$$COMPRES^PRODUKT(PC) K @("^"_Q_"PR2(PCC)")
62 S K=@("^"_Q_"PR(R,0)"),PC=$P(K,D,1),PCC=$$COMPRES^PRODUKT(PC) K @("^"_Q_"PR1(PCC)")
63 S I2="I"
64 S I2=$N(@("^"_Q_"PR(R,I2)")) G 66:$E(I2,1)'="I" S K=^(I2),PHG=$P(K,D,1),PGR=$P(K,D,2),PSG=$P(K,D,3)
65 K @("^"_Q_"PH(PHG,PGR,PSG,""  "",PCC)"),@("^"_Q_"PM(""  "",PHG,PGR,PSG,PCC)") G 64
66 S I2="J"
67 S I2=$N(@("^"_Q_"PR(R,I2)")) G 69:$E(I2,1)'="J" S K=^(I2),PLE=$P(K,D,1)_" ",PLRE=$P(K,D,3)_" "
68 K @("^"_Q_"PL(PLE,""  "",PLRE,PCC)") G 67
69 K @("^"_Q_"PR(R)") G 61:'$D(@("^"_Q_"PWSPC(PCC)")) S K=$P(^(PCC),D,3) K ^(PCC),@("^"_Q_"PWSVN(K)") G 61
 ;
7 S R=0
71 S R=$N(PR(R)) G 8:R=-1,71:R=PR S I2=0
72 S I2=$N(@("^"_Q_"STPR(R,I2)")),I3=-1 I I2=-1 K @("^"_Q_"STPR(R)") G 71
73 S I3=$N(@("^"_Q_"STPR(R,I2,I3)")) I I3=-1 K @("^"_Q_"STKL(I2,R)") G 72
74 S K=^(I3) I I3=0 S:'$D(@("^"_Q_"STPR(PR,I2,I3)")) ^(I3)=K D S2 S:'$D(@("^"_Q_"STKL(I2,PR,I3)")) ^(I3)=K D S2 G 73
75 S T="",$P(T,D,27)="" I $D(@("^"_Q_"STPR(PR,I2,I3)")) S T=^(I3)
76 D S1 S ^(I3)=T,T="",$P(T,D,27)="" I $D(@("^"_Q_"STPR(PR,0,I3)")) S T=^(I3)
77 D S1 S ^(I3)=T,T="",$P(T,D,27)="" I $D(@("^"_Q_"STKL(I2,PR,I3)")) S T=^(I3)
78 D S1 S ^(I3)=T G 73
 ;
8 S I1=0,I2="F"
81 S I1=$O(@("^"_Q_"UL(I1)")) G 9:I1="" S I3=0
83 S I3=$O(@("^"_Q_"UL(I1,I2,I3)")) G 81:I3="" S I4=100
85 S I4=$O(@("^"_Q_"UL(I1,I2,I3,I4)")) G 83:'I4 S K=^(I4),R=$P(K,D,2) I R,R'=PR,$D(PR(R)) S $P(K,D,2)=PR,^(I4)=K
87 G 85
 ;
9 K @("^"_Q_"HULP($J)") S @%Q1=1
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 20.04.89 - 10 u 44