KTORT G 1 ;MODULE RANGSCHIKKEN TOELEVERING ;Quit naar KTO10 [ 05/05/99  1:34 PM ]
 ;
M1 S MSG=TOU_" "_TR_" BEVAT KOM BESTELLINGEN" G MY
MY S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K G YZ
 ;
SC S PCC=$$COMPR^PRODUKT(PR)
 Q
 ;
1 S SW12=1,X=^(1),UAF=$P(X,D,22) G M1:UAF=2
 S UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
2 S UZ=100,Q15="^(""W    0.0T""_UOD_$J(TR,6,0)_$J((UZ-100),3,0))",Q16="@(""^""_Q_""PR(PR,""""W    0.0T""""_UOD_$J(TR,6,0)_$J((UZ-100),3,0))"")"
20 K @("^"_Q_"HULP($J)")
3 S UZ=$N(@("^"_Q_UGL_"(LC,TR,UZ)")) G 9:UZ=-1 S U2=^(UZ),PR=$P(U2,D,2) G 3:'PR K ^(UZ),^KTO3(TR,$P(U2,D,13,14)_D_UZ)
5 S PC=$P(@("^"_Q_"PR(PR,0)"),D,1) D SC S X="I",X=$N(@("^"_Q_"PR(PR,X)")),U22=@Q15 K @Q15
7 S:$E(X,1)'="I" X=" \ \ " S:$E(X,1)="I" X=$P(^(X),D,1,3) S @("^"_Q_"HULP($J,$P(X,D,1),$P(X,D,2),$P(X,D,3),PCC,UZ)")=U2,^(UZ,1)=U22 G 3
9 G 23:'$D(@("^"_Q_"HULP($J)")) S UZ=100,PHG=""
11 S PHG=$N(@("^"_Q_"HULP($J,PHG)")) G 23:PHG=-1 S PGR=""
13 S PGR=$N(@("^"_Q_"HULP($J,PHG,PGR)")) G 11:PGR=-1 S PSG=""
15 S PSG=$N(@("^"_Q_"HULP($J,PHG,PGR,PSG)")) G 13:PSG=-1 S PCC=""
17 S PCC=$N(@("^"_Q_"HULP($J,PHG,PGR,PSG,PCC)")) G 15:PCC=-1 S UVN=0
19 S UVN=$N(@("^"_Q_"HULP($J,PHG,PGR,PSG,PCC,UVN)")) G 17:UVN=-1 S U2=^(UVN),U22=^(UVN,1),PR=$P(U2,D,2)
21 S UZ=UZ+1 G 21:$D(@("^"_Q_UGL_"(LC,TR,UZ)")) S @("^"_Q_UGL_"(LC,TR,UZ)")=U2,^KTO3(TR,$P(U2,D,13,14)_D_UZ)="",@Q16=U22 G 19
23 K PC,PCC,PR,PHG,PGR,PSG,U22,UOD,UOR,UAF,UVN,UZ,U2,Q15,Q16 I $D(@("^"_Q_"HULP($J)")) K ^($J) D ^KTO15
 ;
YZ K UAF,X Q
 ;
 Q
Z X ^cZ Q
ZZ ; 19.04.91 - 14 u 37