cPE31 G 10 ;WIJZIGEN PRODUKTEN - SCHERM 1-X ;OVERLAY VAN %P30 [ 03/11/2002   4:37 PM ]
 ;
T1 ;ER BESTAAN 
T2 ;SCHERMEN.
T3 ;SCHERM 
T4 ;NUMMER ELEMENT   -[] = einde : 
T5 ;EVEN GEDULD A.U.B. 
 ;
SC S SI="",T=0 F SX=1:1:99 S SX1=$E(PC,SX) G SCZ:SX1="" I SX1'?1P S SI=SI_SX1
SCZ S PCC=SI_" " K SI,SX,SX1 Q
 ;
S1 S B(2)=$P(B(2),D,1,23)_D_DT_D_$P(B(2),D,25,999) Q:VPR=K!'$P(B(1),D,14)
S10 S Y=$D(@("^"_Q_"PR(I1,""J"")")),MRK="",Y="J"
S12 S Y=$N(^(Y)) G S2:$E(Y,1)'="J" G S12:$P(^(Y),D,35)'="*" S MRK=$P(^(Y),D,2)
S2 L @("^"_Q_"PEW"):2 E  S FP=2403+F60 W @F,@F4,$P($T(T5),U,2),@F5,@F0 H 2 G S2
S3 S ENR=0,ESW=1 S:$D(@("^"_Q_"PEW(0)")) ENR=^(0) S ENR=ENR+1,@("^"_Q_"PEW(ENR)")=$P(B(1),D,1)_D_MRK_D_$P(B(1),D,2)_D_K_D_$S($P(B(2),D,2):$P(B(1),D,14),1:1)_D_"*"_D_$E(DJ\10_(DM\10)_DD_(DM#10)_(DJ#10),3,8),^(0)=ENR
S4 K ENR,VPR S FP=2403 W @F,@F2 Q
 ;
ER K @("^HBPWP"_$J) 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)
 ;
10 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)
12 S SW2=U5,FP=455 W @F,@F2 S FP=465 W @F,@F5 I SW4>1 S FP=455 W @F,@F4,$P($T(T3),U,2),SW2," ",@F5
15 S I2=0,B(1)=@("^"_Q_"PR(I1,I2)") F I=1:1:6 I $D(^(I)) S B(I+1)=^(I)
20 K A S (X,K)=SW2*100,Y=$D(@("^"_Q_"PR(0,0)")) S FP=601 W @F,@F1 I SW2>1 S K=K+2
30 S X=$N(^(X)) G 40:X=-1!(X>((SW2+1)*100)) S K=K+1,A(K)=^(X) G 30
40 S SW7=0,U4=2,U1=SW2*100+2
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
60 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)
70 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 X:$L($P(U2,U,8)) "S U3="_$P(U2,U,8)
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 S FP=2203+F60 W @F,@F1,$P($T(T4),U,2),@F0
100 R U1 G 90:U1?.E1C.E!($L(U1)>2) G 182:U1="-",100:U1="",90:'$D(A(U1+(SW2*100))) S U2=A(U1+(SW2*100)) I U1=1 S PC=$P(B(1),D,1) D SC S OCC=PCC
105 I $P(U2,U,16)=107 S VPR=$P(B(1),D,7)
110 I $P(U2,U,12),@$P(U2,U,15) X ^cTXT(0,"N",69) R Y G 90
112 I $L($P(U2,U,17)),@$P(U2,U,18) X $P(U2,U,17) G 90:K="-"!(K=","),170
114 I $L($P(U2,U,19)),@$P(U2,U,20) X $P(U2,U,19) G 90:K="-"!(K=","),170
120 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)
130 S FP=2200+F60+($L($P(U2,U,1))+6) W @F,@F0 R K G 130:K?.E1C.E,90:K="-"!(K=",")
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))"
150 I @X G 170:U1'=1,120:K="" S PC=K D SC G 165:$D(@("^"_Q_"PR1(PCC)"))&(OCC'=PCC) S @%Q1=0 K @("^"_Q_"PR1(OCC)") S ^(PCC)=I1_D_PC,@%Q1=1 D ^cPE310 G 170
160 G 120
165 X ^cTXT(0,"N",67) R Y G 120
170 D S1:$P(U2,U,16)=107 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
180 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) G 90
182 I $D(X3) D @X3 G YZ:OK=1 I 'OK G 90
190 K U1,U2,U3 S @%Q1=0,X="^"_Q_"PR(I1,I2)=B(1)",@X F I=1:1:6 I $D(^(I)) S ^(I)=B(I+1)
 I $D(ESW) X:$D(@("^"_Q_"PR(0,11)")) ^(11)
 S @%Q1=1
YZ K A Q
 ;