cPE113 G 1 ;REGISTRATIE TOELEVERINGEN (NIEUWE TOELEV.) ;Quit naar %PE112 [ 11/08/2003  3:27 PM ]
 ;
ER S %1=0 G ^II:$ZE["<INTERRUPT>",^cER
 ;
1 S X=@Q1,(X,K)=100,UUR="",SW11=0
14 S X=$N(^(X)) G 15:X=-1!(X'?.N) S K=K+1,A(K)=^(X) G 14
15 S U1=100,U4=0
16 S U1=$N(A(U1)) G 36:U1=-1&'SW11,39:SW11&(U1'=UUR) S U0=U1,U2=A(U1),B($P(U2,U,16))="" S:$P(U2,U,16)="TR" UUR=U1
160 I $L($P(U2,U,4)),@$P(U2,U,4) G YZ:K="-"&(U1=101),16:K'="-" S U1=U1-2 G 16
17 I $L($P(U2,U,7)),@$P(U2,U,14) S U3="S K="_$P(U2,U,7) X U3 S (U3,B($P(U2,U,16)))=K G 33:K'="-",YZ:U1=101 S U1=U1-2,U4=U4-1 G 16
18 I $L($P(U2,U,17)),@$P(U2,U,18) S U3=$P(U2,U,17) X U3 S (U3,B($P(U2,U,16)))=K G 181:K'="-",YZ:U1=101 S U1=U1-2,U4=U4-1 G 16
180 G 184
181 S FP=2203+F60 W @F,@F1,$P(U2,U,1)," : ",$E(PNT,1,$P(U2,U,9))
182 S FP=2206+F60+$L($P(U2,U,1)) W @F,K,!?2,"[] = OK" S FP=2206+F60+$L($P(U2,U,1)) W @F,@F0 R K G 18:K?.E1C.E,33:K=""
183 S (U3,B($P(U2,U,16)))=K G 33:K'="-",YZ:U1=101 S U1=U1-2,U4=U4-1 G 16
184 I $L($P(U2,U,19)),@$P(U2,U,20) S U3=$P(U2,U,19) X U3 S (U3,B($P(U2,U,16)))=K G 33:K'="-",YZ:U1=101 S U1=U1-2,U4=U4-1 G 16
19 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)
20 S FP=2200+F60+($L($P(U2,U,1))+6) W @F,@F0 R K G 20:K?.E1C.E,YZ:U1=101&(K="-"),15:K="," I K="-" S U1=U1-2,U4=U4-1 G 16
22 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 S B($P(U2,U,16))=K,U3=K
23 E  G 19
33 I $L($P(U2,U,8)) S U3="S U3="_$P(U2,U,8) X U3
330 S U4=U4+1,FP=$P(A(U1),U,2)*100+$P(A(U1),U,3) I $P(A(U1),U,22) W @F W:U4<10 " " W U4
332 I '$P(A(U1),U,23) 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) S:'$P(A(U1),U,22) FP=FP+2 W @F,@F6,$P(A(U1),U,1),@F5
34 S FP=$P(A(U1),U,5)*100+$P(A(U1),U,6) W @F,$E(BLA,1,$P(A(U1),U,9)),$E(BLA,1,$P(A(U1),U,13)),@F,U3 G 16:$P(U2,U,16)?.N
35 S @$P(U2,U,16)=B($P(U2,U,16)) K B($P(U2,U,16)) G 16
36 S T=0 G 39:TR'="A"
38 L (@Q1,TR) S TR=@Q1
380 I $D(@("^"_Q_UG1_"(TR)")) S TR=TR+1 G 380
381 S @Q1=TR+1
382 I UUR S U1=UUR-1,SW11=1 G 16
39 S @("^"_Q_UG1_"(TR)")=LC_D,@("^"_Q_UG2_"(LC,TR)")="",@("^"_Q_UGL_"(LC,TR,0)")=101,SW13=1 L @("^"_Q_UGL_"(LC,TR)")
4 S U7="",T=T+100 I $N(B(T))=-1 G YZ
40 S (U1,U2,U3)="",B(115)=UKIL
41 F Y=1:1:25 S X=Y+T S:$D(B(X)) U7=U7_B(X) S U7=U7_D
42 S ^(T/100)=U7 G 4
 ;
YZ K A Q
 ;
S1 D R1 G S1Z:K="-" S K=$P(K," ",2)
S1Z Q
 ;
R1 S R4=$P(R,D,2)+1,R0=0,RA=$P(R,D,3),R8="^"_Q_$P(R,D,4),R9="^"_Q_$P(R,D,5),FP=R4 W @F,@F1
R1A S FP=2403+F60 W @F,@F1,"NAAM OF NUMMER v/d ",RA W:R0 "   [] = VERVOLG" W " : ",@F0
R1B R K G R1A:K?.E1C.E S:$L(K) R0=0 S FP=R4 W @F,@F1 G R1Z:K="-" I K="" S R1=R4 G R1H:R0,R1D
R1C G R1D:K'?.N,R1K:'$D(@(R9_"(K)")) S R3=^(K) I $D(@(R8_"(R3)")) G R1M
R1D S R6="" F R7=1:1:99 I $E(K,R7)'?1P S R6=R6_$E(K,R7)
R1E S R5=$E(R6,1,24) S:R6="" R5=" " S R1=R4,R2=R5,(R2,R3)=$N(@(R8_"(R2)")) G R1K:R2=-1 S R2=$N(^(R2))
R1F I $E(R2,1,$L(R6))'=R6&'R0&($E(R3,1,$L(R6))=R6) S R7=$D(^(R3)) G R1M
R1G S R2=R5
R1H S R2=$N(@(R8_"(R2)")) G R1K:($E(R2,1,$L(R6))]R6)&'R0&(R1=R4) G R1L:R2=-1 I $E(R2,1,$L(R6))'=R6 S R0=0 G R1A
R1I S FP=R1 W @F,$C(13),$P(^(R2,0),D,1),?6,$E($P(^(0),D,2),1,26),?33,$E($P(^(0),D,5),1,26),?60,$E($P(^(0),D,7),1,20)
R1J S R1=R1+100 G R1H:R1<(2300+F60) S R0=1 G R1A
R1K S FP=2403+F60 W @F,@F2,@F4,RA," ONBEKEND ",@F5,@F0 H 3
R1L S (R2,R0)=0 G R1A
R1M S (@$P(R,D,1),K)=R3
R1Z K R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,RA Q  ;V2 06.06.84
 ;
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)
 ;