cPE4 G 1 ;LIJST KLASSIFIKATIES ; [ 11/08/2003  3:50 PM ]
 ;
ER X F71 G ^II:$ZE["<INTERRUPT>",^cER
 ;
T1 ;LIJST VAN : .
T2 ;-[] = einde programma
T3 ;LIJST 
T4 ;IN ALFABETISCHE ORDE VANAF 
T5 ;IN ALFABETISCHE ORDE TOT   
T6 ;IN ALFABETISCHE ORDE VANAF 
T7 ;".[] = vanaf het begin   [] = specifieke 
T8 ;VANAF HET BEGIN
T9 ;IN ALFABETISCHE VOLGORDE TOT 
T10 ;".[] = tot het einde   [] = specifieke 
T11 ;TOT HET EINDE
T12 ;PLAATS SMAL BLANCO PAPIER OP PRINTER EN SCHAKEL HEM AAN
T13 ;"[] = ok   ,[] = hernemen"
T14 ;BLZ:
T15 ;: NUM. : 
T16 ;VOLGNUMMER OF 
T17 ;   [] = vervolg
 ;
1 S K=$P($T(+1),U,2)_QN_" " S FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
11 S NM1=@("^"_Q_"BA(99,1)"),NM2=^(2),NM3=^(3)
BREAK1 B 1
13 S PNT="..............................",LIN="------------------------------",Y=$N(@("^"_Q_"PR(0,"" "")")),Y=" "
15 S Y=$N(^(Y)) G 17:Y=-1 S @Y=^(Y) G 15
17 S FP=401 W @F,@F1 S SEL="",FP=2203+F60 W @F,$P($T(T1),U,2)
22 S FP=2303+F60 W @F F I="HG","GR","SG","MK" S Y=$P(@I,D,2) S:Y="" SEL=SEL_" " S SEL=SEL_$E(Y,1,1) I Y'="" W $E(Y,1,1),"[] = ",$P(@I,D,4),"   "
25 S FP=2403+F60 W @F,$P($T(T2),U,2),@F0 S Y=$P(@I,D,2),FP=2210+F60 F I="HG","GR","SG","MK" I Y'="" S FP=FP+$L(Y)+2
27 S FP=2215 W @F R K G 17:K?.E1C.E,BREAK0:K="-",25:K="",17:K=" "!(SEL'[K) S K=$F(SEL,K)-1
30 S Y=$P("HG\GR\SG\MK",D,K),BST="P"_Y,SEL=$P(@Y,D,2),LGT=$P(@Y,D,1),SL=$P(@Y,D,4)
 ;
35 S BLZ=0,(LN,VN)=0
40 S FP=478 W @F,@F5 S FP=470-$L(SEL) W @F,@F4,$P($T(T3),U,2),SEL," ",@F5
50 S (IX1,IX2)="",FP=903 W @F,@F1,$P($T(T4),U,2),SEL," : ",!!,?2,$P($T(T5),U,2),SEL," : "
60 S R="K\23\3\"_$P($T(T6),U,2)_SEL_D_$P($T(T7),U,2)_SL_"""\1\\"".-""[K\\" D R0 G 17:K="-"
62 I K="." S FP=933+$L(SEL) W @F,@F2,$P($T(T8),U,2) G 80
64 S R=1500_D_SEL_D_BST D S7 G 50:K="-" S IX1=R,FP=933+$L(SEL) W @F,@F2,$P(^(R),D,2)
80 S R="K\23\3\"_$P($T(T9),U,2)_SEL_D_$P($T(T10),U,2)_SL_"""\1\\"".-""[K\\" D R0 I K="-" S FP=1500 W @F,@F1 G 50
82 I K="." S FP=1133+$L(SEL) W @F,@F2,$P($T(T11),U,2) G 100
90 S R=1500_D_SEL_D_BST D S7 S:K="-" FP=1500 W:K="-" @F,@F1 G 80:K="-" S IX2=R,FP=1133+$L(SEL) W @F,@F2,$P(^(R),D,2)
100 S X=$N(@("^"_Q_BST_"(IX1)")),R="K\23\3\"_$P($T(T12),U,2)_D_$P($T(T13),U,2)_"\1\\""-,""[K\\\"
110 D R0 G 50:K=",",50:K="-"&(IX1="")&(IX2=""),80:K="-" X F70 W @F80 D H1 G 120:IX1="" S VN=VN+1 G 140
120 S VN=VN+1,IX1=$N(^(IX1)) I IX1=-1 G 170
130 I $L(IX2),IX1]IX2 G 170
140 S A0=$P(^(IX1),D,2)
150 W ! S LN=LN+1 I LN>50 W ":------:",$E(LIN,1,LGT+6),":",# S LN=0 D H1 G 150
160 W ":",?2,$J(VN,4),?7,": ",A0,$J("",LGT-$L(A0)+5),":" G 120
170 W !,":------:",$E(LIN,1,LGT+6),":",# X F71 G 1
 ;
BREAK0 B 0
YZ Q
 ;
H1 S BLZ=BLZ+1,LN=0 W !,NM1,?72,$P($T(T14),U,2),$J(BLZ,4),!,NM2,?24,@F82,$P($T(T3),U,2),SEL,@F83,$C(13),?72,DT
H1A W !,NM3,?73,TD,!
H1B W !!,$P($T(T15),U,2),SEL,$J("",LGT-$L(SEL)+5),":",!,":------:",$E(LIN,1,LGT+6),":"
H1Z 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),S8="^"_Q_$P(R,D,3),FP=S4 W @F,@F1
S7A S FP=2403+F60 W @F,@F1 W:$D(ST) $P($T(T16),U,2) W SA W:S0 $P($T(T17),U,2) W " : ",@F0
S7B R K G S7A:K?.E1C.E!($L(K)>LGT),S7Z:K="-" S:$L(K) S0=0 S FP=S4,S9=0 W @F,@F1 I K="" K ST S S1=S4 G S7F:S0,S7D:'S0
S7C G S7D:'$D(ST(K)) S S3=ST(K) G S7M
S7D K ST S S6="" F S7=1:1:$L(K) I $E(K,S7)'?1P S S6=S6_$E(K,S7)
S7E S S5=$E(S6,1,28) S:S6="" S5=" " S:S5?.N S5=S5_" " S S1=S4,S2=S5 G S7G:$D(@(S8_"(S2)")),S7I:$N(@(S8_"(S2)"))=-1
S7F S S2=$N(@(S8_"(S2)")) G S7I:($E(S2,1,$L(S6))]S6)&'S0&(S1=S4) G S7J:S2=-1 I $E(S2,1,$L(S6))'=S6 S S0=0 G S7A
S7G S FP=S1,S9=S9+1,ST(S9)=S2 W @F,$C(13),?2,$J(S9,2),". ",?6,$P(^(S2),D,2)
S7H S S1=S1+100 G S7F:S1<(2100+F60) S S0=1 G S7A
S7I X ^cTXT(0,"N",156) R K
S7J S (S2,S0)=0 G S7A
S7M S:$E(S3,$L(S3))'=" " S3=S3_" " S R=S3
S7Z K S0,S1,S2,S3,S4,S5,S6,S7,S8,S9,SA,ST Q
 ;
Z X ^cZ Q
ZZ ; 28.05.85 - 17 u 04