KPE33 G 30 ;WIJZIGEN PRODUKTEN - KLASS. LEV. ;OVERLAY VAN KPE30 [ 03/06/2003  9:08 AM ]
 ;
T1 ;WIJZIGEN VAN ELEMENT NR : 
T2 ;([] = vorig   )[] = volgend   
T6 ;W[] = HERREKENEN DEKKINGSBIJDRAGE
T7 ;-[] = einde
T11 ;WIJZIGEN LEVERANC.
 ;
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)
 ;
30 S K=$D(@("^"_Q_"PR(0,0)")),K=100
35 S X=$N(^(X)) G 40:X'?.N!(X>((SW2+1)*100)) S K=K+1,A(K)=^(X) G 35
40 S SW7=0,U4=2,U1=100
50 S U1=$N(A(U1)) G 90:U1<0 S U2=A(U1),X=$P(U2,U,16) S:'$D(B(X\100)) B(X\100)=BS S U3=$P(B(X\100),D,X#100),K=U3 X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8)
60 S FP=$P(U2,U,5)*100+$P(U2,U,6)-3 W:'$P(U2,U,23) @F,@F5,": "
 S FP=$P(U2,U,2)*100+$P(U2,U,3) S:'$P(U2,U,22) FP=FP+2
70 W @F S U4=U4+1 W:$P(U2,U,22) $J(U4,2) W:'$P(U2,U,23) @F6,$P(U2,U,1),@F5
80 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 50
90 I $D(Element) S U1=Element K Element G 100
 S FP=L*100+1 W @F,@F1
 S FP=2103+F60 W @F,@F1,$P($T(T1),U,2),!?2,$P($T(T2),U,2),$P($T(T7),U,2),@F0
 I SW2=12 W !?2,$P($T(T6),U,2)
 S FP=FP+$L($P($T(T1),U,2)) W @F R U1
 I $L(U1)=1,"()"[U1 S Aktie=U1 S U1="-"
 I SW2=12,U1="W" D WINST G 30
100 G 90:U1?.E1C.E G 90:U1="",190:U1="-",90:'$D(A(U1+98)) S LScreen=Screen,LElement=U1,U2=A(U1+98)
110 I $P(U2,U,12),@$P(U2,U,15) X ^cTXT(0,"N",69) R Y G 90
113 S N=$P(U2,U,16) I N=101&(SW) X ^cTXT(0,"N",69) R Y G 90
114 I $L($P(U2,U,19)),@$P(U2,U,20) X $P(U2,U,19) G 90:K="-",170
115 G 120:(SW&(N'=102))!('SW&(N>103)) S IB=$P("PHG\PGR\PSG",D,N#100) S:SW IB="PMK"
117 S R=L*100_D_$P(@($E(IB,2,99)),D,2)_D_IB_D_IB D ^KPE39 G 90:K="-" I $L(K)=1,"()"[K S Aktie=K G 190
 S:K'="," K=$P(@("^"_Q_IB_"(R)"),D,2) S:"-,"[K K=" " S FP=L*100+1 W @F,@F1 G 133
120 S 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)
 W !?2,$P($T(T2),U,2)
130 S FP=2100+F60+($L($P(U2,U,1))+6) W @F,@F0 R K G 130:K?.E1C.E,90:K="-"
 I $L(K)=1,"()"[K S Aktie=K G 190
133 S Y="1" S:$L($P(U2,U,21)) Y="("_$P($T(@$P(U2,U,21)),U,2,99)_")" G 120:$P(Y,",",1)="$L(K)"&(K="") I @Y G 140
135 E  G 120
140 S X=$P(U2,U,11) S:'$L(X) X=1 S X=X_"&'(K[D)&($L(K)'>$P(U2,U,9))!(K="","")" I @X G 170
150 E  G 120
170 S U3=K,X=$P(U2,U,16)\100,Y=$P(U2,U,16)#100,OUD=$P(B(X),D,Y) 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)
180 S K=U3 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 S U2="" K OUD G 90
190 F I=1:1:3 I '$L($P(B(1),D,I)) S:I=1 B(1)=" "_D_$P(B(1),D,2,99) S:I>1 B(1)=$P(B(1),D,1,I-1)_D_" "_D_$P(B(1),D,I+1,99)
200 N C
 S C($E(I2))=B(1) D LOGPRNR^PRODUKT(PR,.C)
 K U1,U2,U3 S @%Q1=0 D DELIND^PRODUKT2(PR)
 S X="^"_Q_"PR(I1,I2)=B(1)",@X,K="W"
 D BLDIND^PRODUKT2(PR)
210 K A S A=@("^HBPWP"_$J_"(I2)") I $P(B(1),D,1,3)'=$P(A,D,1,3),'SW D ^KPE33A
220 K A,B S @%Q1=1
 ;
YZ Q
 ;
SCALC 
 N B
 D ONE^PRSCALC(I1,1)
 Q
 ;
WINST 
 N A
 S @%Q1=0,X="^"_Q_"PR(I1,I2)=B(1)",@X
 S @%Q1=1
 S Locals("I1")=I1
 D DO^vhPROGRAM("SCALC^KPE31")
 S X="B(1)=^"_Q_"PR(I1,0)",@X F I=1:1:6 I $D(^(I)) S B(I+1)=^(I)
 S (X,K)=100,U4=0,Y=$D(@("^"_Q_"PR(0,0)"))
 F  S X=$N(^(X)) Q:X'?.N!(K=102)  S K=K+1,A(K)=^(X)
 S U1=100,FP=301 W @F,@F1
 F  S U1=$N(A(U1)) Q:U1=-1  D
 .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)
 .W @F S U4=U4+1 W $J(U4,2),@F6,$P(A(U1),U,1),@F5
 .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)
 .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
 K B S X="B(1)=^"_Q_"PR(I1,I2)",@X
 S FP=479 W @F,@F5 S FP=455 W @F,@F4,$P($T(T11),U,2)," ",@F5,@F2
 Q
 ;
KLASSIF 
 New A,L,R,HoofdGr,Groep,SubGroep,KortComp,NPRNr
 Set L=$O(^KPR(PR,"J")) If $E(L)'="J" Do KLASSIF^PRODUKT Quit
 Set L=$E(L,2,9),A=B(1)
 Do KLASSIF^PRODUKT
 Set HoofdGr=$P(B(1),D),Groep=$P(B(1),D,2),SubGroep=$P(B(1),D,3),KortComp=""
 If '$D(^KPH(HoofdGr,Groep,SubGroep)) Quit
 Set NPRNr=PR
 For  Set KortComp=$O(^KPH(HoofdGr,Groep,SubGroep,"  ",KortComp)) Quit:KortComp=""  Do  Quit:NPRNr'=PR
 .Set NPRNr=^KPH(HoofdGr,Groep,SubGroep,"  ",KortComp)
 Set R=$O(^KPR(NPRNr,"J")),R=$E(R,2,9)
 If R'=L Do
 .Set FP=2403
 .Write @F,@F2,@F4,"Subgroep ",@FMTB,$$DISPL^KLASS(K),@FMTb," niet van ",@FMTB,$P(^KLE(^KL1(L),0),D,2),@FMTb,"  [] = ok ",@F5,@F0
 .Read K
 .Set B(1)=A,K=$P(A,D,4)
 Quit
 ;