KPE109 G 505 ;SELEKTIE MODULE VOOR LISTINGS IN ^_Q_PL ;OVERLAY VAN %P8 [ 08/05/2002   1:05 PM ]
 ;
T1 ;PLAATS BLANCO PAPIER OP DE PRINTER EN SCHAKEL HEM AAN
T2 ;"[] = ok   ,[] = hernemen"
T3 ;IN ALFABETISCHE ORDE VANAF 
T4 ;IN ALFABETISCHE ORDE TOT   
T5 ;".[] = vanaf het begin   [] = specifieke 
T6 ;VANAF HET BEGIN
T7 ;".[] = tot het einde   [] = specifieke 
T8 ;   I[] = idem vorige"
T9 ;TOT HET EINDE
T10 ;ZELFDE 
T11 ;VOLGNUMMER OF 
T12 ;   [] = vervolg
T13 ;ZONDER
 ;
505 S LN=403,LGT=0 F I="LE","MK","LP" S:$L($P(@I,D,2))>LGT LGT=$L($P(@I,D,2))
510 S (H,HH,G,GG,S,SS,P)="",LN=403 G 520:$P(LE,D,2)="" S SEL=$P(LE,D,2),SEK=$P(LE,D,4),NIV=""
512 S LN=403,H="" D S3 G 70:K="-" S H=R I K="" S H=K
514 S LN=503,HH="" G 510:K="-"&($P(LE,D,2)="") S SEL=$P(LE,D,2),SEK=$P(LE,D,4),NIV="" D S4 G 512:K="-" S HH=R S:K="" HH=K S:K="."&(H'="") HH=H G 550:HH=""&(K'=".") I H]HH!(K="."&(H="")) S LN=LN-100,FP=LN+131+LGT W @F,@F2 G 514
516 G 550:H'=HH
520 I $P(MK,D,2)="" S G="  " G 530
521 G 510:K="-"&(H'=HH) S LN=703,SEL=$P(MK,D,2),SEK=$P(MK,D,4),NIV="H"
522 S LN=703,G="" D S3 G 514:K="-" S G=R I K="" S G=K
524 S LN=803,GG="" G 514:K="-"&($P(MK,D,2)="") S SEL=$P(MK,D,2),SEK=$P(MK,D,4),NIV="H" D S4 G 522:K="-" S GG=R S:K="" GG=K S:K="."&(G'="") GG=G G 550:GG=""&(K'=".") I G]GG!(K="."&(G="")) S LN=LN-100,FP=LN+131+LGT W @F,@F2 G 524
526 G 550:G'=GG
530 G 550:$P(LP,D,2)="",524:K="-"&(G'=GG) S LN=1003,SEL=$P(LP,D,2),SEK=$P(LP,D,4),NIV="H,G"
532 S LN=1003,S="" D S3 G 524:K="-" S S=R I K="" S S=K
534 S LN=1103,SS="" G 524:K="-"&($P(LP,D,2)="") S SEL=$P(LP,D,2),SEK=$P(LP,D,4),NIV="H,G" D S4 G 532:K="-" S SS=R S:K="" SS=K S:K="."&(S'="") SS=S G 550:SS=""&(K'=".") I S]SS!(K="."&(S="")) S LN=LN-100,FP=LN+131+LGT W @F,@F2 G 534
550 G 70:$D(SWP) S R="K\23\3\"_$P($T(T1),U,2)_D_$P($T(T2),U,2)_"\1\\""-,""[K\\\" D R0 G 510:K=","
60 I K="-" S LN=LN-100 G 510:H=""&(HH=""),520:G=""&(GG=""),530:S=""&(SS=""),550
70 Q
 ;
S3 S FP=LN+100 W @F,@F1,$P($T(T3),U,2),SEL,$J("",LGT-$L(SEL)+1)," : " W !,?2,$P($T(T4),U,2),SEL,$J("",LGT-$L(SEL)+1)," : "
S3A S R="K\23\3\"_$P($T(T3),U,2)_SEL_D_$P($T(T5),U,2)_SEK_"""\1\\"".-""[K\\" D R0 S:K="-" LN=LN-100 Q:K="-"  S R=""
S3B I K="" S R=L*100_D_SEL_D_NIV D S7 I K="-" S FP=L*100+1 W @F,@F1 G S3A
S3C S LN=LN+100,FP=LN+31+LGT W @F,@F2 W:K="." $P($T(T6),U,2) I R'="" W R
S3Z Q
 ;
S4 S R="K\23\3\"_$P($T(T4),U,2)_SEL_D_$P($T(T7),U,2)_SEK_$P($T(T8),U,2)_"\1\\"".-I""[K\\" D R0 S:K="-" LN=LN-100 Q:K="-"  S R=""
S4A I K="" S R=L*100_D_SEL_D_NIV D S7 I K="-" S FP=L*100+1 W @F,@F1 G S4
S4B S LN=LN+100,FP=LN+31+LGT W @F,@F1 W:K="." $P($T(T9),U,2) W:K="I" $P($T(T10),U,2),SEL S:K="." K="" I R'="" W R
S4Z S:K="I" K="." 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
 ;
S7 S S4=$P(R,D,1)+1+F60,S0=0,SA=$P(R,D,2),S10=$P(R,D,4),S8="^"_Q_"PL("_$P(R,D,3) S:$L($P(R,D,3)) S8=S8_"," S S8=S8_"S2)",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!(NIV=""&(K=5005)),S7Z:K="-" 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 S K=$$UPCASE^vhRtn1(K) 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 I S2="5005 " G S7H:S1<(2300+F60) S S0=1 G S7A
S7II S FP=S1,S9=S9+1,ST(S9)=S2 W @F,$C(13),?2,S9,". ",?6 W:S2="  " $P($T(T13),U,2) W:S2'="  " S2 I NIV="" W:S2'="  " "   ",$P(@("^"_Q_"LE(@(""^""_Q_""L1(+S2)""),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,SA,ST Q
 ;
Z X ^cZ
ZZ ; 04.07.86 - 15 u 58