cPE35 G 10 ;WIJZIGEN PRODUKTEN - VERWIJDEREN KLASS. LEV. ;OVERLAY VAN %P30 [ 03/11/2002   4:37 PM ]
 ;
T1 ;V[] = verwijderen              -[] = terug naar keuze : 
T2 ;V[] = verwijderen definitief   -[] = terug naar keuze : 
T3 ;" IS VERWIJDERD 
 ;
ER K @("^HBPWP"_$J) G:$ZE["<INTERRUPT>" ^II G ^cER
 ;
10 S FP=2203+F60 W @F,@F1 S X=3 I 'SW F I=1:1:3 S FP=2200+F60+X W @F,$P(B(1),D,I) S X=X+$P(@($P("HG\GR\SG",D,I)),D,3)+5
12 I SW F I=1:1:3 S FP=2200+F60+X W @F W:I'=1 $P(B(1),D,I) W:I=1 $P(@("^"_Q_"LE(@(""^""_Q_""L1($P(B(1),D,1))""),0)"),D,2) S X=X+$P(@($P("LE\MK\LP",D,I)),D,3)+5
14 S X=@("^"_Q_"PR(I1,T(UX))") I $P(X,D,35)="*" X ^cTXT(0,"N",110) R X Q
15 S FP=2303 W @F,@F1,$P($T(T1),U,2),@F0 R K G 15:K?.E1C.E,140:K="-",20:K="V",15
20 S FP=2403 W @F,$P($T(T2),U,2),@F0 R K G 20:K?.E1C.E,140:K="-",30:K="V",20
30 I 'SW K ^(T(UX)) G 50
40 K ^(T(UX)) G 50:T(UX)["." S X=$N(^(T(UX))) G 50:X[T(UX) K @("^"_Q_"LE(@(""^""_Q_""L1($P(B(1),D,1))""),""P""_I1)") S X=$N(^("P")) K:$E(X,1)'="P" ^("P")
50 S X=$N(@("^"_Q_"PR(I1,HI2)")) K:$E(X,1)'=HI2 ^(HI2)
60 K T(UX) S FP=$P(L,D,2)+1+UX*100+3 W @F,@F2
70 S FP=2403+F60 W @F,@F2,@F4 W:'SW $P(HG,D,2) W:SW $P(LE,D,2) W " """,$P(B(1),D,1) W:SW " ",$P(@("^"_Q_"LE(@(""^""_Q_""L1($P(B(1),D,1))""),0)"),D,2) W $P($T(T3),U,2),@F5,@F0 H 2 G 140
100 S X=$N(@("^"_Q_"PR(I1,HI2)")) G 140:X'[HI2
110 S (KX,VN)=$E(X,2,99)\1,X=HI2_KX
120 I $D(@("^"_Q_"PR(I1,X)")) S U7=^(X) K ^(X) S ^(HI2_VN)=U7,VN=VN+.01
130 S X=$N(@("^"_Q_"PR(I1,X)")) G 140:X'[HI2,110:X'[KX,120
140 S K="V"
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 05.06.85 - 10 u 51