KOFKYW G 1 ;MODULE EXTRA KORTING YZERWARENHANDEL ;Do naar KFKYWA - Quit naar %F10 [ 08/05/2002  11:29 AM ]
 ;
M1 S MSG="EXTRA KORTING ENKEL TOEGELATEN VOOR HANDEL MET KWANTUMKORTING" G MY
MY S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K G 29
 ;
1 S SW12=1 G M1:'KYW,M1:'KQG S UZ=K
7 S U2=@("^"_Q_UGL_"(KC,US,UR,(UZ+100))"),PR=$P(U2,D,2),UK=$P(U2,D,7) G YZ:'PR
9 S PK1=$P(UK,"#",1),PK2=$P(UK,"#",2),FP=1901+F60 W @F,@F1,$C(13) W:'PK2 ! W:'PK1 !
10 S PC=$P(@("^"_Q_"PR(PR,0)"),D,1) W ?2,"KORTING VOOR LIJN ",UZ," : ",PC W:PK1 !?2,"%KORTING 1 = ",$J(PK1,4,1) W:PK2 !?2,"%KORTING 2 = ",$J(PK2,4,1)
11 S R="PKO\23\3\%KORTING "_$S('PK1:1,1:2)_"\C1\4\\""-,""[K!(K?.N&($L(K)<3))!(K?.N1"".""1N)" D R0^KFKYWA I K="" S (K,PKO)=$S('PK1:PK1,1:PK2)
13 G YZ:K="-",29:K=",",11:K<0!((K+PK1)>100) S:PK1 PK2=PKO S:'PK1 PK1=PKO
15 S UA=$P(U2,D,3),UN=$P(U2,D,9),UEP=$J(UN/UA,1,2),AFA=$E($P(U2,D,21),1),AFE=$P("1\100\1000",D,$F("EHM",AFA)-1)
16 I KV="MTL" S UMC=$P(U2,D,22),UPAR=$$MUNT^vhRtn1(UMC,,12),UN=$J(UN*UPAR/LPAR,1,2)
17 I PK2 S UEP=$J(UEP/(100-$P(UK,"#",2)/100)*(100-PK2)/100,1,2) G 19
18 S UEP=$J(UEP*(100-PK1)/100,1,2)
19 S U26="*",(UN,UBE)=$J(UEP*UA,1,2),UEP=$J(UEP*AFE,1,2) I KKN S UEP=$P(U2,D,6),UN=$J(UEP/AFE*(100-PK1)/100*(100-PK2)/100*UA,1,2),UBE=$P(U2,D,16)
21 S U2=$P(U2,D,1,5)_D_UEP_D_PK1_"#"_PK2_D_$P(U2,D,8)_D_UN_D_UN_D_$P(U2,D,11,15)_D_UBE_D_$P(U2,D,17,25)_D_U26_D_$P(U2,D,27,99)
22 S:KV="MTL" UN=$J(UN*UPAR/LPAR,1,2)
23 S @("^"_Q_UGL_"(KC,US,UR,(UZ+100))")=U2
25 K UA,UEP,UN,UK,UBE,U26,PK1,PK2,PKO G YZ
29 S K="-"
 ;
YZ K AFA,AFE,UPAR,ULN,UZ,UAF,U2 Q
 ;
SCROL(UVN) 
 S K=UVN-100 G 1