KPSELR G 1 ;SELEKTIE VOOR LISTINGS ;KPSEL; Quit naar KPSELH [ 08/05/2002  10:20 AM ]
 ;
T1 ;VANAF 
T2 ;TOT 
T3 ;IN ALFABETISCHE ORDE VANAF 
T4 ;IN ALFABETISCHE ORDE TOT 
T5 ;\".[] = vanaf het begin   [] = specifieke 
T6 ;VANAF HET BEGIN
T7 ;\"I[] = idem vorige   .[] = tot het einde   [] = specifieke 
T9 ;TOT HET EINDE
T10 ;\PRODUKTKODE\\produktkode
T11 ;Vanaf produkt
T12 ;Tot produkt
 ;
1 S H=@("^"_Q_Q1_"(0,""LE"")"),P=$P($T(T10),U,2)
3 S L=0 F I="H","P" S:$L($P(@I,D,2))>L L=$L($P(@I,D,2))
5 S LN=8,I="H" D S1 S LN=9 D S2
7 S NIV="" D S3,R0 G YZ:K="-" I K="." S LE=0,R=$P($T(T6),U,2) G 11
9 D S5,S10 G 7:K="-" S LE=K,R=+^(K,0)_" "_$P(^(0),D,2)
11 S LN=8 D S6
13 D S4,R0 I K="-" S R="" D S6 K LE G 7:LN=8 S LN=8 D S6 G 7
15 I K="." S LEX="ZZZZZ",R=$P($T(T9),U,2) G 21
17 I K="I" G 13:LE=0 S LEX=LE,R=+@("^"_Q_"LE(LE,0)")_" "_$P(^(0),D,2) G 21
19 D S5,S10 G 13:K="-",19:LE]K S LEX=K,R=+^(K,0)_" "_$P(^(0),D,2)
21 S LN=9 D S6 G 43:LE'=LEX
23 S LN=11,I="P" D S1 S LN=12 D S2
29 S K=$$SELECT^PRODUKT6("L",$P(LE," ",2),"",$P($T(T11),U,2)) I K="-" S LN=9,I="H" D S2 K LEX G 13
 I K="." S PRC=0,R=$P($T(T6),U,2) G 31
 S (PRC,R)=$$COMPR^PRODUKT(K) D S8
31 S LN=11 D S6
39 S K=$$SELECT^PRODUKT6("L",$P(LE," ",2),"",$P($T(T12),U,2)) I K="-" S R="" D S6 K PRC G 29:LN=11 S LN=11 D S6 G 29
 I K="." S PRCX="ZZZZZ",R=$P($T(T9),U,2) G 41
 S R=$$COMPR^PRODUKT(K) G 39:PRC]R S PRCX=R D S8
41 S LN=12 D S6
43 S:'$D(PRC) PRC=0 S:'$D(PRCX) PRCX="ZZZZZ" K @("^"_Q_"HULP($J)")
 S FP=2101 W @F,@F1
 ;
YZ K G,H,I,L,LN,NIV,P,S Q
 ;
S0 S FP=2001+F60 W @F,@F1
S0Z Q
 ;
S1 S FP=LN*100+1 W @F,@F2,$C(13),?2,$P($T(T3),U,2),$P(@I,D,2),?30+L,":"
S1Z Q
 ;
S2 S FP=LN*100+1 W @F,@F1,$C(13),?2,$P($T(T4),U,2),$P(@I,D,2),?30+L,":"
S2Z Q
 ;
S3 D S0 S R="K\23\3\"_$P($T(T1),U,2)_$P(@I,D,2)_$P($T(T5),U,2)_$P(@I,D,4)_"""\1\\""-.""[K"
S3Z Q
 ;
S4 D S0 S R="K\23\3\"_$P($T(T2),U,2)_$P(@I,D,2)_$P($T(T7),U,2)_$P(@I,D,4)_"""\1\\""-.I""[K"
S4Z Q
 ;
S5 S R="K\2000\DE "_$P(H,D,2)_"\LE\L1"
S5Z Q
 ;
S6 S FP=LN*100+33+L W @F,@F2,R
S6Z Q
 ;
S8 S R=+@("^"_Q_"PR1(R)"),R=$P(@("^"_Q_"PR(R,0)"),D,1)
S8Z Q
 ;
R0 S R7="K'[D&(K'?.E1C.E)" S:$P(R,D,8)'="" R7=R7_"&("_$P(R,D,8)_")" S:$P(R,D,7)'="" R7=R7_"&("_$P($T(@$P(R,D,7))," ",2,99)_")"
R0A S R2=$P(R,D,2),R3=$P(R,D,3),R4=$P(R,D,4),R5=$P(R,D,5),R6=$P(R,D,6)
R0B S R0=$L(R4)+R3+3 S FP=R2*100+R3+F60 W @F W:R3<4 @F1 W @F2,R4," : " I R5'="" W:R5["""" !,?2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2 W $E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K
R0E E  G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7 Q  ;V4 03.10.84
 ;
S10 S R4=$P(R,D,2)+1,R0=0,RA=$P(R,D,3),R8="^"_Q_$P(R,D,4),R9="^"_Q_$P(R,D,5),FP=R4 W @F,@F1
S10A X ^cTXT(0,"N",15)
S10B R K G S10A:K?.E1C.E!(K?20N.N) S:$L(K) R0=0 S FP=R4 W @F,@F1 G S10Z:K="-" I K="" S R1=R4 G S10H:R0,S10D
S10C G S10D:K'?.N,S10K:'$D(@(R9_"(K)")) S R3=^(K) I $D(@(R8_"(R3)")),$D(@("^"_Q_"PL(K_"" "")")) G S10M
S10D S R6=$$UPTRIMAN^vhRtn1(K)
S10E S R5=$E(R6,1,24) S:R6="" R5=" " S R1=R4,R2=R5,(R2,R3)=$N(@(R8_"(R2)")) G S10K:R2=-1 S R2=$N(^(R2))
S10F I $E(R2,1,$L(R6))'=R6&'R0&($E(R3,1,$L(R6))=R6)&$D(@("^"_Q_"PL($P(R3,"" "",2)_"" "")")) G S10M
S10G S R2=R5
S10H S R2=$N(@(R8_"(R2)")) G S10K:($E(R2,1,$L(R6))]R6)&'R0&(R1=R4) G S10L:R2=-1,S10H:'$D(@("^"_Q_"PL($P(R2,"" "",2)_"" "")")) I $E(R2,1,$L(R6))'=R6 S R0=0 G S10A
S10I S FP=R1 W @F,$C(13),$J(+@(R8_"(R2,0)"),6),?7,$E($P(^(0),D,2),1,26),?34,$E($P(^(0),D,5),1,26),?61,$E($P(^(0),D,7),1,18)
S10J S R1=R1+100 G S10H:R1<(2300+F60) S R0=1 G S10A
S10K X ^cTXT(0,"N",8) R K
S10L S (R2,R0)=0 G S10A
S10M S (@$P(R,D,1),K)=R3,R7=$D(@(R8_"(R3)"))
S10Z K R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,RA Q  ;V4 23.05.85
 ;