KTO26 G 1 ;MODULE INBOEKEN VAN EEN VOLLEDIGE TOELEVERING ;Do naar KTR20 ;Quit naar KT11 [ 05/10/99  1:54 PM ]
 ;
1 S SW12=1,X=100,Q15="^(""W""_WNR_$J(UMA,5,1)_""T""_TR_$J(UZ,3,0))",Q19="^(""W""_WNR_$J(UMA,5,1)_0)"
 S DAI=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp(DT),"DS"),D,"")_1
10 S X=$N(@("^"_Q_UGL_"(LC,TR,X)")) G 100:X=-1
20 I $P(^(X),D,2)="" S X=$N(^(X)) G 100:X=-1,20
30 S X1=^(X),PR=$P(X1,D,2),UZ=X-100,Y=@("^"_Q_"PR(PR,3)")
40 I $P(X1,D,22) F I=1:1:15 S UMA=$P(Y,D,I+1) I $L(UMA) K @Q15
50 G 10:$P(X1,D,22) S I=1
60 S I=I+1 G 10:I>16 S UMA=$P(Y,D,I) G 60:'$L(UMA)!'$D(@Q15)
70 S PA=$P(@Q19,D,19),PV=$P(@Q19,D,7),PH=$P(@Q15,D,5) I (PH=0) K @Q15 G 60
80 S R=DAI_D_PH_D_PA_"\1\"_PV_"\\\"_TR_"\" D ^KTR20 K @Q15 G 60
100 K @("^"_Q_UGL_"(LC,TR)"),@("^"_Q_UG1_"(TR)"),@("^"_Q_UGB_"(TR)"),@("^"_Q_UG2_"(LC,TR)") S K=","
 ;
YZ K Q15,Q19,DAI,X,Y,PA,PV,PH,UMA,X1 Q
 ;
Z X ^cZ Q
ZZ ; 21.04.88 - 12 u 36