KF12 G 1 ;REGISTRATIE UITLEVERINGEN (TONEN HOOFDING INDIEN $D) ;Quit naar KF30 [ 11/12/2002  11:17 AM ]
 ;
1 K A N TYPE,OrdLink S METTYP="\OD\OFKL\UL\",(X,K)=100,Y=$D(@("^"_Q_UGL_"(0,US,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 B(1)=@("^"_Q_UGL_"(KC,US,UR,1)") F I=2:1:6 I $D(^(I)) S B(I)=^(I)
40 S U1=100,U4=0,TYPE=$P(B(1),D,25),OrdLink=""
 I UGL="UL",TYPE'="M",TYPE'="P" S TYPE=""
 I UGL="OD" Set OrdLink=$P(B(1),D,41)
50 S U1=$N(A(U1)) G 90:U1<0 S U2=A(U1),X=$P(U2,U,16)
51 I $P(U2,U,16)'?.N!($P(U2,U,16)<101)&$L($P(U2,U,7)) S U3="S U3="_$P(U2,U,7) X U3 G 56:$P(U2,U,16)?.N S @$P(U2,U,16)=U3 G 56
52 I X'?.N S U3=@X G 56
54 S U3=$P(B(X\100),D,X#100)
56 S K=U3 I $L($P(U2,U,8)) S U3="S U3="_$P(U2,U,8) X U3
60 I $P(U2,U,22) S FP=$P(U2,U,2)*100+$P(U2,U,3) W @F S U4=U4+1 W:U4<10 " " W U4
70 I '$P(U2,U,23) S FP=$P(U2,U,5)*100+$P(U2,U,6)-3 W @F,@F5,":" S FP=$P(U2,U,2)*100+$P(U2,U,3) S:'$P(U2,U,22) FP=FP+2 W @F,@F6,$P(U2,U,1),@F5
80 S FP=$P(U2,U,5)*100+$P(U2,U,6) W @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13))
85 I $P(U2,U,16)="UR" D  G 50
 .W @FMTB,@F,U3,@FMTb
 .W:METTYP[(D_UGL_D)&$L(TYPE) @FMTB,@FMTK
 .W:METTYP[(D_UGL_D) $P(" \s\c\a\k\l\y\m\p\t",D,$F("SCAKLYMPT",TYPE))
 .W:OrdLink @FMTK,"~"
 .W @FMTb,@FMTk
87 W @F,U3 G 50
90 K A,B G YZ:'$D(@("^"_Q_UGL_"(0,US,""UDET"")")) I $P(^("UDET"),D,1) S K="D" D @($P(^("UDET"),D,2))
 ;
YZ K A,B,METTYP Q
 ;