cPE36 G 5 ;WIJZIGEN PRODUKTEN - OPENEN, WIJZIGEN, VERWIJDEREN DEELPRODUKTEN ;OVERLAY VAN %P30 [ 11/08/2003  3:49 PM ]
 ;
T1 ;VOLGNUMMER OF 
T2 ;   [] = vervolg
T3 ;DEELPRODUKTEN 
T4 ;Wxx[] = wijzigen   Vxx[] = verwijderen   
T5 ;O[] = OPENEN   
T6 ;$P("\vervolg",D,SW10+1)
T7 ;   -[] = einde :
T8 ;DEELPRODUKT : 
T9 ;V[] = verwijderen              -[] = keuze : 
T10 ;V[] = verwijderen definitief   -[] = keuze : 
T11 ;DEELPRODUKT "
T12 ;" IS VERWIJDERD 
T13 ;AANTAL : 
T14 ;OPENEN DEELPRODUKTEN 
T15 ;PRODUKTKODE
 ;
R7 S R4=$P(R,D,2)+1+F60,R0=0,RA=$P(R,D,3),R8="^"_Q_$P(R,D,4),R9="^"_Q_$P(R,D,5),FP=R4 W @F,@F1
R7A S FP=2403+F60 W @F,@F1 W:$D(RT) $P($T(T1),U,2) W RA W:R0 $P($T(T2),U,2) W " : ",@F0
R7B R K G R7A:K?.E1C.E S:$L(K) R0=0 S FP=R4,R10=0 W @F,@F1 G R7Z:K="-",R7D:K=""&('R0) I K="" K RT S R1=R4 G R7H
R7C G R7D:'$D(RT(K)) S R3=RT(K) G R7M
R7D K RT S R6="" F R7=1:1:99 I $E(K,R7)'?1P S R6=R6_$E(K,R7)
R7E S R5=$E(R6,1,28) S:R6="" R5=" " S R1=R4,(R2,R3)=R5 G R7M:$D(@(R9_"(R2_"" "")")) S:R5?.N R5=R5_" " S (R2,R3)=$N(@(R9_"(R5)")) G R7K:R2=-1 S R2=$N(^(R2))
R7F I $E(R2,1,$L(R6))'=R6&'R0&($E(R3,1,$L(R6))=R6) S R7=$D(@(R8_"(R3)")) G R7M
R7G S R2=R5
R7H S R2=$N(@(R9_"(R2)")) G R7K:($E(R2,1,$L(R6))]R6)&'R0&(R1=R4) G R7L:R2=-1 I $E(R2,1,$L(R6))'=R6 S R0=0 G R7A
R7I S FP=R1,R10=R10+1,RT(R10)=R2 W @F,$C(13),?2,R10,". ",?6,$P(^(R2),D,2),?37,$E($P(@(R8_"($P(@(R9_""(R2)""),D,1),0)"),D,2),1,30)
R7J S R1=R1+100 G R7H:R1<(2300+F60) S R0=1 G R7A
R7K X ^cTXT(0,"N",8) R K
R7L S (R2,R0)=0 G R7A
R7M S:$E(R3,$L(R3))'=" " R3=R3_" " S (@$P(R,D,1),K)=R3
R7Z K R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RT Q
 ;
ER G:$ZE["<INTERRUPT>" ^II G ^cER
 ;
5 S FP=255 W @F,@F2 S FP=472 W @F,@F5 S FP=455 W @F,@F4,$P($T(T3),U,2),@F5,@F2 S FP=601 W @F,@F1
230 S VN=0,(I2,HI2)="D" I '$D(@("^"_Q_"PR(I1,HI2)")) S LN=602 G 340
240 K T S SW10=1,VX=VN,FP=602 W @F,@F1
245 S (FP,LN)=FP+100 G 250:(FP\100)=17 S I2=$N(@("^"_Q_"PR(I1,I2)")) G 250:$E(I2,1)'=HI2 S VN=VN+1,T(VN)=I2,Y=$P(^(I2),D,1),X=$P(@("^"_Q_"PR($E(I2,2,99),0)"),D,1)
247 W @F,$J(VN,2),". ",X,$J("",28-$L(X)+4-$L(Y)),"x",Y,"   ",$E($P(^(0),D,2),1,30) G 245
250 S:$E(I2,1)'=HI2 SW10=0 S FP=2203+F60 W @F,@F1,$P($T(T4),U,2) W:'SW10 $P($T(T5),U,2) W @$P($T(T6),U,2),$P($T(T7),U,2),@F0
260 R U5 G 250:U5?.E1C.E,YZ:U5="-",240:U5=""&($E(I2,1)=HI2),330:'SW10&(U5="O") S Z=+$E(U5,2,99) G 250:"VW"'[$E(U5,1),250:(Z'>VX)!(Z>VN),250:('$D(@("^"_Q_"PR(I1,T(Z))"))),300:$E(U5,1)="W"
265 S X=$P(@("^"_Q_"PR($E(T(Z),2,99),0)"),D,1),FP=2203+F60 W @F,@F1,$P($T(T8),U,2),X,"   ",$P(^(0),D,2)
267 S FP=2303+F60 W @F,@F1,$P($T(T9),U,2),@F0 R K G 267:K?.E1C.E,250:K="-",270:K="V",267
270 S FP=2403+F60 W @F,@F1,$P($T(T10),U,2),@F0 R K G 270:K?.E1C.E,250:K="-",280:K="V",270
280 S I=Z S:I>9 I=$E(I,2,99) S:I=0 I=10 S FP=606+(I*100) W @F,@F2 S FP=2403+F60 W @F,@F2,@F4,$P($T(T11),U,2),X,$P($T(T12),U,2),@F5,@F0 H 3
290 K ^("E"_I1) S Y=$N(^("E")) K:$E(Y,1)'="E" ^("E") K @("^"_Q_"PR(I1,T(Z))") S Y=$N(^(HI2)) K:$E(Y,1)'=HI2 ^(HI2)
292 S Y="" F I=1:1:$L(X) I $E(X,I)'?1P S Y=Y_$E(X,I)
294 S Y=Y_" " K @("^"_Q_"PD(PCC,Y)") G 250
300 S FP=2203+F60 W @F,@F1,$P($T(T8),U,2),$P(@("^"_Q_"PR($E(T(Z),2,99),0)"),D,1),"   ",$E($P(^(0),D,2),1,30)
310 S FP=2408+F60 W @F,@F2,$P($T(T13),U,2),@F0 R K G 310:K?.E1C.E,250:K="-",310:K'?.N!(K<1)!(K>9999)
320 S I=Z S:I>9 I=$E(I,2,99) S:I=0 I=10 S FP=634+(I*100) W @F,"     " S FP=FP+4-$L(K) W @F,"x",K S (^("E"_I1),@("^"_Q_"PR(I1,T(Z))"))=K_BS G 250
330 S LN=LN-100
340 S FP=478 W @F,@F5 S FP=455 W @F,@F4,$P($T(T14),U,2),@F5,@F2
350 S R="R\1800\"_$P($T(T15),U,2)_"\PR\PR1" D R7 G YZ:K="-" S DP=$P(@("^"_Q_"PR1(R)"),D,1),R=$P(^(R),D,2) G 350:DP=I1!($D(@("^"_Q_"PR(I1,HI2_DP)")))
360 S FP=2203+F60 W @F,@F1,$P($T(T8),U,2),R,"   ",$E($P(@("^"_Q_"PR(DP,0)"),D,2),1,30)
370 S FP=2408+F60 W @F,@F2,$P($T(T13),U,2),@F0 R K G 370:K?.E1C.E,350:K="-",370:K'?.N!(K<1)!(K>9999)
380 S (FP,LN)=LN+100,VN=VN+1 S:(LN\100)=17 (FP,LN)=702 W:FP=702 @F,@F1 W @F,$J(VN,2),". ",R
390 S FP=LN+36-$L(K) W @F,"x",K,"   ",$E($P(^(0),D,2),1,30) S ^("E")="",^("E"_I1)=K_BS,@("^"_Q_"PR(I1,HI2)")="",^(HI2_DP)=K_BS
392 S Y="" F I=1:1:$L(R) I $E(R,I)'?1P S Y=Y_$E(R,I)
394 S Y=Y_" ",@("^"_Q_"PD(PCC,Y)")=I1_D_DP G 350
 ;
YZ K A,B,I,J,LN,T,VN,Z Q
 ;
Z X ^cZ Q
ZZ ; 05.09.85 - 12 u 32