KF33 ;TRANSFERT OFFERTES ;SYNONIEMENROUTINES [ 08/05/2002  10:44 AM ]
 ;
ER S %1="1" G:$ZE["<INTERRUPT>" ^II G ^cER
 ;
R1 D R1^cA101
 Q
 ;
S2 S S4=$P(R,D,1)+1,S0=0,SA=$P(R,D,2),S8="^"_Q_$P(R,D,3),K="",FP=S4 W @F,@F1 G S2B
S2A S FP=2403+F60 W @F,@F1,"NUMMER ",SA W:S0 "   [] = vervolg" W " : ",@F0 R K G S2A:K?.E1C.E
S2B S:$L(K) S0=0 S FP=S4 W @F,@F1 G S2Z:K="-"!(K=".") I K="" S S1=S4 G S2H:S0,S2D
S2C G S2A:K'?.N S S3=K G S2A:'$D(@(S8_"(KC,US,S3)")),S2A:'$P(^(S3,1),D,9),S2M
S2D S S6=$$UPTRIMAN^vhRtn1(K)
S2E S S5=$E(S6,1,24) S:S6="" S5=0 S S1=S4,S2=S5,(S2,S3)=$N(@(S8_"(KC,US,S2)")) G S2K:S2=-1 S S2=$N(^(S2))
S2F I $E(S2,1,$L(S6))'=S6&'S0&($E(S3,1,$L(S6))=S6) S S3=$P(S3," ",2)_" ",S7=$D(@(S8_"("""_S3_""")")) G S2M
S2G S S2=S5
S2H S S2=$N(@(S8_"(KC,US,S2)")) G S2K:($E(S2,1,$L(S6))]S6)&'S0&(S1=S4) G S2L:S2=-1
S2I G S2H:'$P(^(S2,1),D,9) S FP=S1 W @F,$C(13),?1,S2,?9,$P(^(1),D,2),?21,$P(^(1),D,3)
S2J S S1=S1+100 G S2H:S1<(2300+F60) S S0=1 G S2A
S2K S FP=2403+F60 W @F,@F2,@F4,SA," IS ONBEKEND [] = ok ",@F5,@F0 R K G S2:$N(^(-1))'=-1 S K="-" G S2Z
S2L S (S2,S0)=0 G S2A
S2M S R=S3
S2Z K S0,S1,S2,S3,S4,S5,S6,S7,S8,SA Q  ;V2 06.06.84
 ;