KPHGS G 1 ;SELEKTIE VOOR PRODUKTEN (klass.);KPHGS; [ 08/05/2002   4:17 PM ]
 ;
T1 ; ONBEKEND  [] = ok 
 ;
1 S H=@("^"_Q_Q1_"(0,""HG"")"),G=^("GR")
11 G 2:$P(U2,U,16)=101 I '$D(B("I101")) S K=$P(H,D,2) D S1 G YZ
13 G 2:$P(U2,U,16)=102 I '$D(B("I102")) S K=$P(G,D,2) D S1 G YZ
 ;
2 S NIV="" I $P(U2,U,16)'=101 S NIV="HG",HG=$P(B("I101"),D,1)_" " I $P(U2,U,16)'=102 S NIV="HG,GR",GR=$P(B("I102"),D,1)_" "
21 S R=2200_D_$P(U2,U,1)_D_NIV D S7 I K'="-" S K=$E(R,1,$L(R)-1)
 ;
YZ K H,G,HG,GR,NIV,PROG Q
 ;
S1 S FP=2403+F60 W @F,@F2,@F4,K,$P($T(T1),U,2),@F5,@F0 R K S K="-"
S1Z Q
 ;
S7 S S4=$P(R,D,1)+1+F60,S0=0,SA=$P(R,D,2),S11=$P(R,D,3),S8="^"_Q_"PH("_S11 S:$L(S11) S8=S8_"," S S8=S8_"S2)",S10="^"_Q_"PR(PR,0)",FP=S4 W @F,@F1
S7A S FP=2403+F60 W @F,@F1 W:$D(ST) $P($T(T11),U,2) W SA W:S0 $P($T(T12),U,2) W " : ",@F0
S7B R K G S7A:K?.E1C.E,S7Z:K="-" D:S11="HG,GR,SG,MK" SC S:$L(K) S0=0 S FP=S4,S9=0 W @F,@F1 G S7D:K=""&('S0) I K="" K ST S S1=S4 G S7H
S7C G S7D:'$D(ST(K)) S S3=ST(K) G S7M
S7D K ST S S6=K S:K=" " S6=""
S7E S S5=$E(S6,1,28),S1=S4 S:S6="" (S2,S3,S5)=0 S:S6'="" (S2,S3,S5)=S5_" " G S7M:$D(@(S8)) S (S2,S3)=$N(@(S8)) G S7K:S2=-1 S S2=$N(^(S2))
S7F I $E(S2,1,$L(S6))'=S6&'S0&($E(S3,1,$L(S6))=S6) G S7M
S7G S S2=S5
S7H S S2=$N(@(S8)) G S7K:($E(S2,1,$L(S6))]S6)&'S0&(S1=S4) G S7L:S2=-1 I $E(S2,1,$L(S6))'=S6 S S0=0 G S7A
S7I S FP=S1,S9=S9+1,ST(S9)=S2 W @F,$C(13),?2,S9,". ",?6 I NIV'="HG,GR,SG,MK" W:S2="  " $P($T(T13),U,2) W:S2'="  " S2 G S7J
S7II S PR=+^(S2) W $P(@S10,D,1),?34,$P(^(0),D,2)
S7J S S1=S1+100 G S7H:S1<(2300+F60) S S0=1 G S7A
S7K X ^cTXT(0,"N",156) R K
S7L S (S2,S0)=0 G S7A
S7M S R=S3
S7Z K S0,S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,SA,ST Q
 ;
SC ; Lijn toegevoegd voor Caché
 Quit
 ;