KFKYW G 1 ;MODULE EXTRA KORTING YZERWARENHANDEL ;Do naar KFKYWA - Quit naar %F10 [ 08/05/2002  10:44 AM ]
 ;
M1 S MSG="EXTRA KORTING ENKEL VOOR HANDEL MET KWANTUMKORTING EN NETTO PRIJZEN" G MY
MY S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K G 29
 ;
S0 S UVN=$N(@("^"_Q_UGL_"(KC,US,UR,UVN)")) G S0Z:UVN=-1
S0A S U2=^(UVN),UZ=UVN-100 F I=1:1:35 I $L($P(U2,D,I)) S @$P("UG\UC\UA\UE\UO\UEP\UK\UB\UN\UH\UGK\UF\X\X\X\UBE\UM\X\X\X\USP\UMC\URD\X\ULT\U26\U27\U28\U29\U30\U31\U32\U33\U34\U35",D,I)=$P(U2,D,I) I I=7 D S2
S0B S:$P($P(U2,D,17),"#")="KF1925"&('$P(U2,D,3)) UEP=UBE I UL>$P(UD,D,2) S UL=UL-1,FP=UD*100+1 W @F,@FDL D S1
S0B1 S X=0 I $D(UC) S UC=$P(@("^"_Q_"PR(UC,0)"),D,1)
S0C S UTEL=UTEL+1,UTB(UTEL)=UVN-100,UVLL=UVN,UTA(UVN-100)=UL
S0D S X=X+1,UP=$P(UUM,D,X) G S0F:UP="",S0D:'$D(@$P(UP,U,1)) S FP=UL*100+1+$P(UVV,",",$P(UP,U,2)) W @F I $P(UP,U,3)="L" W @$P(UP,U,1) G S0D
S0E W $J(@$P(UP,U,1),$P(UVV,",",($P(UP,U,2)+1))-$P(UVV,",",$P(UP,U,2))-1) G S0D
S0F G S0H:'($P($P(U2,D,17),"#",1)="KF11"!($P(U2,D,17)="KFVT")!($P($P(U2,D,17),"#")="KF1925"&('$P(U2,D,3)))) F I=2,5,45,55,67,71,73,79 S FP=UL*100+I W @F,"|"
S0G G S0I
S0H X:$P($P(U2,D,17),"#")'="KF1925" UV I $P($P(U2,D,17),"#")="KF1925" F I=2,5,38,45,55,67,71,73,79 S FP=UL*100+I W @F,"|"
S0I S UL=UL+1 K UG,UC,UA,UE,UO,UEP,UK,UB,UN,UH,UGK,UF,UBE,UM,USP,UMC,URD,ULT,UZ,U26,U27,U28,U29,U30,U31,U32,U33,U34,U35
S0Z Q
 ;
S1 F I=UTEL-($P(UD,D,2)-$P(UD,D,1)):1:UTEL S:$D(UTA(UTB(I))) UTA(UTB(I))=UTA(UTB(I))-1
S1A K UTA(UTB(UTEL-($P(UD,D,2)-$P(UD,D,1)))),UTB(UTEL-($P(UD,D,2)-$P(UD,D,1)))
S1Z Q
 ;
S2 S X="" S:$P(UK,"#",1) X=$J($P(UK,"#",1),4,1) S:$P(UK,"#",2) X=X_" "_$J($P(UK,"#",2),4,1) S UK=X
S2Z Q
 ;
S3 S X=0
S3A S X=X+1,UP=$P(UUM,D,X) G S3Z:UP="",S3A:'$D(@$P(UP,U,1)) S FP=ULN*100+1+$P(UVV,",",$P(UP,U,2)) W @F
S3B I $P(UP,U,3)="L" W @$P(UP,U,1) W:$P(UP,U,1)'="U26" $E(BLA,1,$P(UVV,",",($P(UP,U,2)+1))-$P(UVV,",",$P(UP,U,2))-1-$L(@$P(UP,U,1))) G S3A
S3C W $J(@$P(UP,U,1),$P(UVV,",",($P(UP,U,2)+1))-$P(UVV,",",$P(UP,U,2))-1) G S3A
S3Z Q
 ;
1 N Scrol I $D(ScrolOrd) S Scrol=ScrolOrd
 I $D(ScrolBon) S Scrol=ScrolBon
 S SW12=1 G M1:'KYW,M1:'KQG,M1:'KKN I $G(Scrol) S UZ=K G 7
 G 2:'$D(UTA)!'$D(UTB)
 S U2=@("^"_Q_UGL_"(KC,US,UR,1)"),UAF=$P(U2,D,22) I 'UAF G 5:UL'>$P(UD,D,2)
2 S UVN=100,UL=+UD,FP=UD*100+1 W @F,@F1 K UTA,UTB
3 S FP=UL*100+1 W @F,@F1 F Y=$P(UD,D,1):1:$P(UD,D,2) D S0 Q:UVN=-1
5 S FP=1901+F60 W @F,@F1 S FP=2403+F60 W @F,"NUMMER v/d LIJN" I UVN'=-1,($N(@("^"_Q_UGL_"(KC,US,UR,UVN)"))'=-1) W "   [] = VERVOLG"
6 W "   -[] = TERUG NAAR ",$P(USM,U,3)," : ",@F0 R UZ G 5:UVN=-1&(UZ=""),3:UZ="",29:"-,"[UZ,5:'$D(UTA(UZ))
7 S U2=@("^"_Q_UGL_"(KC,US,UR,(UZ+100))"),PR=$P(U2,D,2),UK=$P(U2,D,7)
8 I 'PR G YZ:$G(Scrol) S FP=2403+F60 W @F,@F2,@F4,"EXTRA KORTING VOOR LIJN ",UZ," ONMOGELIJK [] = OK ",@F5,@F0 R K G 5
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 5:K="-"&'$G(Scrol),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 S UTOT=UTOT-UN,UEP=$J(UEP/(100-$P(UK,"#",2)/100)*(100-PK2)/100,1,2) G 19
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) S UTOT=UTOT+UN D SHOWTOT^KFTOT(UTOT)
23 S @("^"_Q_UGL_"(KC,US,UR,(UZ+100))")=U2,UK=$J(PK1,4,1) S:PK2 UK=UK_" "_$J(PK2,4,1)
25 K UA I '$G(Scrol) S ULN=UTA(UZ) D S3 K UEP,UN,UK,UBE,U26,PK1,PK2,PKO G 5
 K 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