cPE116 G 1 ;MODULE WIJZIGEN HOOFDING ;Quit naar %PE115 [ 03/06/2002  4:50 PM ]
 ;
ER S %1=0 G ^II:$ZE["<INTERRUPT>",^cER
 ;
1 S (X,K)=100,Y=$D(@("^"_Q_UGL_"(0,0)"))
20 S X=$N(^(X)) G 30:X=-1!(X'?.N) S K=K+1,A(K)=^(X) G 20
30 K B S SW12=1,B(1)=@("^"_Q_UGL_"(LC,TR,1)") F I=2:1:6 I $D(^(I)) S B(I)=^(I)
40 S U1=100,U4=0
50 S U1=$N(A(U1)) G 90:U1<0 S U2=A(U1)
70 S FP=$P(U2,U,2)*100+$P(U2,U,3) W @F S U4=U4+1 W:U4<10 " " W U4 G 50
90 S FP=2203+F60 W @F,@F1,"NUMMER ELEMENT : ",@F0 R K G 90:K?.E1C.E!(K=""),180:"-,"[K,90:'$D(A(K+100)) S U2=A(K+100)
110 I $P(U2,U,12),@$P(U2,U,15) S FP=2403+F60 W @F,@F2,@F4,"NIET WIJZIGBAAR ",@F5,@F0 H 2 G 90
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="-",180:K=","
140 S X=$P(U2,U,11)_"&'(K[D)&($L(K)'>$P(U2,U,9))" S:$L($P(U2,U,21)) X=X_"&("_$P($T(@$P(U2,U,21)),U,2,99)_")" I @X G 160
150 G 120
160 S SW13=1,U3=K I $L($P(U2,U,8)) S U3="S U3="_$P(U2,U,8) X U3
163 S FP=$P(U2,U,5)*100+$P(U2,U,6) W @F,$E(BLA,1,$P(U2,U,9)),$E(BLA,1,$P(U2,U,13)),@F,U3
165 I $P(U2,U,16)'?.N!($P(U2,U,16)<101) G 90:$P(U2,U,16)?.N S @$P(U2,U,16)=K G 90
170 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
180 K U2,U3 S U1=100,X="^"_Q_UGL_"(LC,TR,1)=B(1)",@X F I=2:1:6 I $D(^(I)) S ^(I)=B(I)
185 G YZ:K=","
190 S U1=$N(A(U1)) G YZ:U1=-1 S U2=A(U1)
200 I '$P(U2,U,22) S FP=$P(U2,U,2)*100+$P(U2,U,3) W @F,"  " G 190
 ;
YZ K A,B 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)
 ;