cPE40 G 10 ;VERWIJDEREN PRODUKTEN ;OVERLAY NAAR %P0
 ;
T1 ;ER BESTAAN 
T2 ;SCHERMEN.
T3 ;V[] = verwijderen              -[] = terug naar produktkeuze : 
T4 ;V[] = verwijderen definitief   -[] = terug naar produktkeuze : 
T5 ;PRODUKTKODE "
T6 ;" IS VERWIJDERD 
T7 ;HET PRODUKT HEEFT VERVANGINGSNUMMER(S) 
T8 ;EN KAN NIET VERWIJDERD WORDEN  [] = ok 
 ;
SC S SI="",T=0 F SX=1:1:99 S SX1=$E(B(101),SX) G SCZ:SX1="" I SX1'?1P S SI=SI_SX1
SCZ S PCC=SI_" " K SI,SX,SX1 Q
 ;
ER G:$ZE["<INTERRUPT>" ^II G ^cER
 ;
10 S X=$N(@("^"_Q_"BA(18,-1)")) F X=0:1:9 S:$D(^(X)) PBTW(X)=$P(^(X),D,1) S:$D(^(X+10)) PTXT(X)=$P(^(X+10),D,1)
13 S Y=$N(@("^"_Q_"PR(0,"" "")")),Y=" " S:$D(^(4)) X3=^(4)
17 S Y=$N(^(Y)) G 20:Y=-1 S @Y=^(Y) G 17
20 S U=";",(SW2,SW4,SW5,SW6,U5)=1,(SW1,SW10,U4)=0,Y=@("^"_Q_"PR(0,1)"),RVW=$P($P($T(+1),U,2)," ",1)
30 I ($N(^(SW4+1*100)))\100=(SW4+1) S SW4=SW4+1 G 30
 ;
60 S FP=226+$L(QN) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,$P($T(+1),U,2),QN," ",@F5
90 S SW7=0 K A,B D ^cPE01 G YZ:I1="-" S X=100
95 I SW4>1 S FP=269 W @F,@F5 S FP=255 W @F,$P($T(T1),U,2),@F4,SW4," ",@F5,$P($T(T2),U,2)
105 S K=100,Y=$D(@("^"_Q_"PR(0,0)")) S:SW2>1 K=K+2
 ;
110 S X=$N(^(X)) G 115:X'?.N!(X>((SW2+1)*100)) S K=K+1,A(K)=^(X) G 110
115 S HI1=I1,SW1=1,U1=100,FP=601 W:SW5 @F,@F1
120 G 130:SW10 S B(1)=@("^"_Q_"PR(I1,0)") F I=1:1:6 I $D(^(I)) S B(I+1)=^(I)
122 S K="V",K=$N(^(K)) I $E(K,1)="V" S FP=2303+F60 W @F,@F1,@F4,$P($T(T7),U,2),@F5,!,?2,@F4,$P($T(T8),U,2),@F5,@F0 R K G 90
130 S U1=$N(A(U1)) I U1=103&(SW4>1)&('SW10) S FP=466 W @F,@F5 S FP=455 W @F,@F4,"SCHERM ",SW2," ",@F5,@F2
135 G 300:U1<0,150:'SW5,130:SW7&(U1'>102) S FP=$P(A(U1),U,5)*100+$P(A(U1),U,6)-3 W:'$P(A(U1),U,23) @F,@F5,": " S FP=$P(A(U1),U,2)*100+$P(A(U1),U,3)
140 W @F S U4=U4+1 W:$P(A(U1),U,22) $J(U4,2) W:'$P(A(U1),U,23) @F6,$P(A(U1),U,1),@F5
150 G 130:SW10&(U1'>102) S U2=A(U1),X=$P(U2,U,16),U3=$P(B(X\100),D,X#100),K=U3 X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8)
155 S FP=$P(U2,U,5)*100+$P(U2,U,6) W @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13)),@F,U3 G 130
 ;
300 K A,B S U4=0,FP=2203+F60 W @F,@F1 S B(1)=@("^"_Q_"PR(I1,0)"),(PC,B(101))=$P(B(1),D,1),I1=HI1 D SC S IN2="E",X=$N(^(IN2))
305 L (@("^"_Q_"PR1(PCC)"),@("^"_Q_"PR(I1)")):2 E  X ^cTXT(0,"N",163) R K G 90
310 I $E(X,1)=IN2 X ^cTXT(0,"N",113) R K G 460
320 I $P(B(1),D,14) X ^cTXT(0,"N",144) R K G 460
330 I $P(B(1),D,17) X ^cTXT(0,"N",145) R K G 460
335 I $D(^("W")) X ^cTXT(0,"N",116) R K G 460
340 S FP=2303+F60 W @F,@F1,$P($T(T3),U,2),@F0 R K G 340:K?.E1C.E,460:K="-",350:K="V",340
350 S FP=2403+F60 W @F,$P($T(T4),U,2),@F0 R K G 350:K?.E1C.E,460:K="-",352:K="V",350
 ;
352 I $D(X3) D @X3 G 90:OK=1 I 'OK G 460
 ;
360 S (X,IN2)="J",@%Q1=0
365 S X=$N(@("^"_Q_"PR(I1,X)")) G 370:$E(X,1)'=IN2 S Y=$E(X,2,99)\1 K @("^"_Q_"LE(@(""^""_Q_""L1(Y)""),""P""_I1)") S Y=$N(^("P")) K:$E(Y,1)'="P" ^("P") G 365
370 K A,B S IN2="I",X=@("^"_Q_"PR(I1,0)"),X="I" F Y=1:1 S X=$N(^(X)) G 380:$E(X,1)'=IN2 S A(IN2_Y)=^(X)
380 S (X,IN2)="J" F Y=1:1 S X=$N(^(X)) G 390:$E(X,1)'=IN2 S B(IN2_Y)=^(X)
390 S:'$D(A("I1")) A("I1")=" \ \ " S:'$D(B("J1")) B("J1")=" \ \ " S I="I",J="J"
400 S I=$N(A(I)) G 410:I=-1
405 S J=$N(B(J)) G 400:J=-1 K @("^"_Q_"PH($P(A(I),D,1)_"" "",$P(A(I),D,2)_"" "",$P(A(I),D,3)_"" "",$P(B(J),D,2)_"" "",PCC)") G 405
410 S I="I",J="J"
420 S I=$N(A(I)) G 436:I=-1
425 S J=$N(B(J)) G 420:J=-1 K @("^"_Q_"PM($P(B(J),D,2)_"" "",$P(A(I),D,1)_"" "",$P(A(I),D,2)_"" "",$P(A(I),D,3)_"" "",PCC)") G 425
436 S J="J"
440 S J=$N(B(J)) G 450:J=-1 K @("^"_Q_"PL($P(B(J),D,1)_"" "",$P(B(J),D,2)_"" "",$P(B(J),D,3)_"" "",PCC)") G 440
450 S (X,IN2)="D",Z="E"
453 S X=$N(@("^"_Q_"PR(I1,X)")) G 454:$E(X,1)'=IN2 S Y=$E(X,2,99) K @("^"_Q_"PR(Y,Z_I1)") S Y=$N(^(Z)) K:$E(Y,1)'=Z ^(Z) G 453
454 K @("^"_Q_"PD(PCC)")
455 K @("^"_Q_"PR1(PCC)"),@("^"_Q_"PR(I1)") S FP=2403+F60 W @F,@F2,@F4,$P($T(T5),U,2),PC,$P($T(T6),U,2),@F5,@F0 H 2
460 S SW1=0,@%Q1=1 L  G 90
 ;
YZ Q
 ;
Z X ^cZ Q
ZZ ; 17.12.85 - 15 u 38