KF5CC G 1 ;MODULE UITLEVEREN ORDERS (TRANSFERT) ;Quit naar KF20CC [ 04/17/2001  4:38 PM ]
 ;
1 N IsEuro
 S IsEuro=$$ISEURO^vhRtn1()
 S UUD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp(FDT),"DS"),D,"")
 S Q15="^(""W    0.0""_UOR_UOD_$J(UR,6,0)_$J((UZ-100),3,0))",UGW=0,UZ=100
2 S X=@("^"_Q_"OD(KC,US,UR,1)"),UVM=$P(X,D,18),UPAR=$$MUNT^vhRtn1(UVM,,12)
3 S UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
 S UOR=$P("R\O",D,$P(X,D,17)+1)
5 S UZ=$N(@("^"_Q_"OD(KC,US,UR,UZ)")) G 17:UZ=-1
 D KWNODE^FLOWORD(KC,UR,UZ)
 S U2=@("^"_Q_"OD(KC,US,UR,UZ)"),PR=$P(U2,D,2) G 5:'PR
7 S UA=$P(U2,D,3),UH=$P(U2,D,10)*UPAR,VWTYP=$P(U2,D,14),U2=$P(U2,D,1,16)_D_"KF6"_D_$P(U2,D,18,99),^(UZ)=U2
9 L (@("^"_Q_"OD(KC,US)"),@("^"_Q_"PR(PR)")):2 E  D M2 G 11
11 S X=@("^"_Q_"PR(PR,1)"),UGW=UGW+($P(X,D,13)/1000*UA)
12 S X=^(2),PRE=$P(X,D,9),PRE=($P(PRE,"#",1)-UA)_"#"_($P(PRE,"#",2)-UA)_"#"_$P(PRE,"#",3)
13 S X=$P(X,D,1,8)_D_PRE_D_$P(X,D,10,99),^(2)=X K @Q15 K:$E($N(^("W")),1)'="W" ^("W")
15 I UA'<0 S R=UUD_2_D_$S(VWTYP["S":0,VWTYP["Z":0,1:UA)_D_D_1_D_$J($S(VWTYP["S":0,VWTYP["Z":0,1:UH),0,$S(IsEuro:4,1:2))_"\0\0\"_UR D ^KPR10
16 S R=PR_D_UUD_D_UA_D_$J(UH,1,2)_D_($P($P(U2,D,28),";")="KOM") D ^KPUW G 5
17 S X=^(1),X=$P(X,D,1,12)_D_"##"_UGW_D_$P(X,D,14,99),^(1)=X
 ;
YZ K UUD,Q15,UGW,X,UVM,UPAR,UOD,UOR,U2,PR,UA,PRE,UH,VWTYP Q
 ;
M2 S MSG="PRODUKT IN GEBRUIK" G MY
MY S FP=2403+F60 W @F,@F4,MSG," ! [] = OK ",@F5,@F0 R K
MZ K MSG Q
 ;