KPE15 G 80 ;OPENEN PRODUKTEN - KLASS. LEV. ;OVERLAY VAN KPE12-NAAR %P6,KPE16 [ 11/06/2001  11:12 AM ]
 ;
T1 ;[] = openen   N[] = niet openen
T2 ;"GEEF HET NUMMER VAN HOOFD",$P("KLASSIFICATIE"_D_$P(MK,D,2),D,SW+1)," : "
 ;
ER G:$ZE["<INTERRUPT>" ^II G ^cER
 ;
S1 S U3=K I $P(U2,U,16)#100=1 S B($P(U2,U,16)\100)=K_D_$P(B($P(U2,U,16)\100),D,2,99) G S1Z
S1A S B($P(U2,U,16)\100)=$P(B($P(U2,U,16)\100),D,1,$P(U2,U,16)#100-1)_D_K_D_$P(B($P(U2,U,16)\100),D,$P(U2,U,16)#100+1,99)
S1Z Q
 ;
80 S U1=$N(A(U1)) G 170:U1=-1 S UX=U1,U2=A(U1),X=K,K="" D S1 S K=X I $L($P(U2,U,4)),@$P(U2,U,4) G 80:K'="-" S U1=U1-2 G 80
85 I $L($P(U2,U,7)),@$P(U2,U,14) X "S K="_$P(U2,U,7) D S1 G 150
90 I $L($P(U2,U,19)),@$P(U2,U,20) X $P(U2,U,19) G 200^KPE16:K=",",123:K'="-" S U1=U1-2 G 80
91 S N=$P(U2,U,16) G 97:'SW!(N'=101)
 S R="R\"_(L*100)_"\"_$P(LE,D,2)_"\LE\L1" D ^cPE6 I K="-" S U1=U1-2 G 80
 S (K,LV)=$P(R," ",2),LX=R,X=$P(^(R,0),D,2) D S1
92 G 150:'$D(@("^"_Q_"PR(PR,IN2_LV)")) S FP=2203+F60 W @F,$P(LE,D,2)," """,X,""" IS REEDS GEOPEND : ."
93 S FP=2303+F60 W @F,$P($T(T1),U,2) S FP=2226+F60+$L($P(LE,D,2))+$L(X) W @F,@F0 R X G 92:X?.E1C.E,91:X="N",92:X'="" S X=IN2_LV
95 S X=$N(^(X)) G 96:X'[K S LV=$E(X,2,99) G 95
96 S LV=LV+.01 G 150
97 G 100:('SW&(N>103))!(SW&(N'=102)),150:'N
 S IB=$P("PHG\PGR\PSG",D,N#100) S:SW IB="PMK" I $L(IB),'$D(@("^"_Q_IB)) S @("^"_Q_IB)=""
98 S K="-",R="R\"_(L*100)_D_$P(@($E(IB,2,99)),D,2)_D_IB_D_IB D ^cPE17:$E($N(^KPR(PR,"I")),1)'="I"!(IB'="PHG") G 99:K="-"&(N>101),200:(K="-"&(N=101)) S:K'="," U3=$P(@("^"_Q_IB_"(R)"),D,2) S:K="," U3=" " S K=U3 D S1 G 150
99 S U1=U1-2 G 80
100 S FP=2203+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)
110 S FP=2200+F60+($L($P(U2,U,1))+6) W @F,@F0 R K G 110:K?.E1C.E,230^KPE16:$P(U2,U,16)=101&(K="") I K="-" S U1=U1-2 G 80
120 G 200^KPE16:K=","
123 S Y="1" S:$L($P(U2,U,21)) Y="("_$P($T(@$P(U2,U,21)),U,2,99)_")" G 100:$P(Y,",",1)="$L(K)"&(K="") I @Y G 130
124 E  G 100
130 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 D S1 G 150
140 G 100
 ;
150 X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8) S FP=$P(A(U1),U,5)*100+$P(A(U1),U,6)
160 W @F,$J("",$P(A(U1),U,9)),$J("",$P(A(U1),U,13)),@F,U3 G 80
170 G 170^KPE16
 ;
200 G 230^KPE16:'VN S:VN=1 K=1 G 210:VN=1 S FP=2203+F60 W @F,@F1,@$P($T(T2),U,2),@F0 R K G 85:K="-",200:K?.E1C.E!(K<1)!(K>SWS)
210 S Y=$P(L,D,1)-2-$P(L,D,2) I (K\Y)=(SWS\Y) S FP=K#Y*100+4+($P(L,D,2)*100)+100 W @F,"*"
220 I 'SW S Y=@("^"_Q_"PR(PR,""I""_K)"),Y=$P(Y,D,1,34)_D_"*"_D_$P(Y,D,36,99),^("I"_K)=Y
230 I SW S Y=@("^"_Q_"PR(PR,""J""_LZ(K))"),Y=$P(Y,D,1,34)_D_"*"_$P(Y,D,36,99),^("J"_LZ(K))=Y
240 G 230^KPE16
 ;
YZ K A,B,I,IB,IN2,J,LN,LV,LX,R,SW,VN,U7,Z Q
 ;
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)
 ;