cPE26 G 1 ;SEQUENTIEEL WIJZIGEN PRODUKTEN VOLGENS PRODUKTKODE (scherm 1-X) ; Quit naar %P25 [ 03/06/2002  4:57 PM ]
 ;
T1 ;SCHERM 
T2 ;NUMMER ELEMENT : ..
T3 ;.[] = volgend produkt
T4 ;-[] = keuze element   .[] = volgend produkt
 ;
ER G:$ZE["<INTERRUPT>" ^II G ^cER
 ;
DCTR ;K?2N1"."2N1"."2N&($P(K,".",1)>0)&($P(K,".",2)>0)&($P(K,".",1)<32)&($P(K,".",2)<13)&'("04060911"[$P(K,".",2)&($P(K,".",1)=31))&'(+$P(K,".",2)=2&(('($P(K,".",3)#4)&($P(K,".",1)>29))!($P(K,".",3)#4&($P(K,".",1)>28))))!("-"[K)
 ;
SC S SI="",T=0 F SC=1:1:99 S SC1=$E(PC,SC) G SCZ:SC1="" I SC1'?1P S SI=SI_SC1
SCZ S PCC=SI_" " K SI,SC,SC1 Q
 ;
1 S SW2=USCH,(SW5,U4)=0,FP=401 W @F,@F1 I SW4>1 S FP=465 W @F,@F5 S FP=455 W @F,@F4,$P($T(T1),U,2),SW2," ",@F5
3 S (X,K)=100,Y=$D(@("^"_Q_"PR(0,0)")) F I=1,2 S X=$N(^(X)),K=K+1,A(K)=^(X)
5 I SW2>1 S X=SW2*100
7 S X=$N(^(X)) G 9:X=-1!(X>((SW2+1)*100)) S K=K+1,A(K)=^(X) G 7
9 I $L(PCCF) S PR=+@("^"_Q_"PR1(PCCF)") G 33
29 S PCCF=$N(@("^"_Q_"PR1(PCCF)")) G YZ:PCCF=-1!(PCCF]PCCL) S PR=+^(PCCF)
33 L @("^"_Q_"PR(PR)"):2 E  X ^cTXT(0,"N",117) R K G 33
35 S U1=100,B(1)=@("^"_Q_"PR(PR,0)") F I=1:1:6 I $D(^(I)) S B(I+1)=^(I)
37 S U1=$N(A(U1)) G 45:U1<0 S U2=A(U1),X=$P(U2,U,16) S:'$D(B(X\100)) B(X\100)="\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" S U3=$P(B(X\100),D,X#100),K=U3 X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8)
39 G 43:SW5 S FP=$P(A(U1),U,5)*100+$P(A(U1),U,6)-3 W @F,@F5,": " S FP=$P(A(U1),U,2)*100+$P(A(U1),U,3)
41 W @F S U4=U4+1 W $J(U4,2),@F6,$P(A(U1),U,1),@F5
43 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 37
45 G 49:$D(K)&$D(UNE) S SW5=1,FP=2103+F60 W @F,@F1,$P($T(T2),U,2),!,?2,$P($T(T3),U,2) S FP=2120 W @F,@F0 R K G 71:K=","!(K="-")!(K=".")
47 K UNE I K?.E1C.E!'$D(A(K+100))!(SW2>1&(K<3)) G 45
49 S:'$D(UNE) UNE=K S U2=A(UNE+100) I UNE=1 S PC=$P(B(1),D,1) D SC S OCC=PCC
51 I $P(U2,U,12),@$P(U2,U,15) X ^cTXT(0,"N",69) R K K UNE G 45
53 S SW5=1,FP=2103+F60 W @F,@F1,$P(U2,U,1)," : ",$E(PNT,1,$P(U2,U,9)) W:$L($P(U2,U,10)) !?2,$P(U2,U,10)
54 W !?2,$P($T(T4),U,2)
55 S FP=2100+F60+($L($P(U2,U,1))+6) W @F,@F0 R K G 55:K?.E1C.E,71:K=","!(K=".") I K="-" K K G 45
57 S Y="1" S:$L($P(U2,U,21)) Y="("_$P($T(@$P(U2,U,21)),U,2,99)_")" G 53:$P(Y,",",1)="$L(K)"&(K="") I @Y G 61
58 E  G 53
61 G 67:UNE'=1,53:K="" S PC=K D SC G 65:$D(@("^"_Q_"PR1(PCC)"))&(OCC'=PCC) K @("^"_Q_"PR1(OCC)") S ^(PCC)=PR_D_PC G 67
63 G 53
65 X ^cTXT(0,"N",67) R K G 53
67 S U3=K X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8) 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
69 S X=$P(U2,U,16)\100,Y=$P(U2,U,16)#100,U2="" S:(Y-1) K=D_K S B(X)=$P(B(X),D,1,Y-1)_K_D_$P(B(X),D,Y+1,99) K K G 45
71 K U2,U3 S X="^"_Q_"PR(PR,0)=B(1)",@X F I=1:1:6 I $D(^(I)) S ^(I)=B(I+1)
73 G 29:K="."
 ;
YZ K A Q
 ;