ImportPakket ;Pakket : orderverwerking [ 09/24/2003   2:14 PM ]

 New Pakket,PR,S,UA,SW25,UE,UN,UAF,UOD,UOR,UVM,X,UTYP
 New AFA,AFE,AFR,KPC,GR,OGR,BGR,KKD,UPAR,PKP,PLL,PST,PB,PLQ,PC,PK1,PK2,PLP,PPL,PID,PRE,PSN,PVK,PGV,PNV,PKV,PY,Q15
 Set R=^KOD(KC,US,UR,1),UVM=$P(R,D,18),UTYP=$P(R,D,25)
 If '$$CHKMUNT^FLOW(UVM) Do OpmMuntNietToegelaten Set K="-" Quit
 Set UOD=$TR($$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes($P(R,D,2)),"DS"),D,"")
 Set UOR=$P("R\O",D,$P(R,D,17)+1)
 Do SELIMP^PAKKETS(.Pakket,KC) If '$D(Pakket) Set K="-" Quit
 Do CopieerPakket
 Lock ^KOD(KC,US,UR)
 Quit
 
CopieerPakket 
 New R,PakketNr,Next,Pak,Taal,PakketBegin,PakketEinde
 Set UZ=^KOD(KC,US,UR,0),PakketNr=""
 Set Taal=$P(^KKL(^KK1(KC),0),D,9)
 Set PakketNr=$P(Pakket,D)
 If $L($P(Pakket,D,2)),$P(Pakket,D,5)>1 Do
 .Set Pak=^PAKKET("D",PakketNr)
 .Set R=$P(Pak,D,2),PakketEinde=$S(Taal="F":"Fin",Taal="D":"Ende",Taal="E":"End",1:"Einde")_" "_R
 .Set PakketBegin=$J("",$L(PakketEinde)-$L(R)\2)_R,PakketBegin=PakketBegin_$J("",$L(PakketEinde)-$L(PakketBegin))
 .Set PakketBegin="** "_PakketBegin_" **",PakketEinde="** "_PakketEinde_" **"
 .Set R="",$P(R,D,36)="",$P(R,D,5)=PakketBegin,$P(R,D,17)="KF11#1",$P(R,D,18)=$P($H,",",2)_";T;;OBFT"
 .Do TINSERT^FLOWORD("","",R) Quit
 Set Next=""
 For  Set Next=$O(Pakket(Next)) Quit:Next=""  Do
 .Set R=Pakket(Next) Quit:$P(R,D)'="P"
 .Set PR=$P(R,D,2),UA=$P(R,D,3),R=$$VerwerkEenProduct(PR,UA,UZ) Quit:R=""
 .Set ^KOD(KC,US,UR,UZ)=R,UZ=UZ+1
 Do:$L($G(PakketEinde))
 .Set R="",$P(R,D,36)="",$P(R,D,5)=PakketEinde,$P(R,D,17)="KF11#1",$P(R,D,18)=$P($H,",",2)_";T;;OBFT"
 .Do TINSERT^FLOWORD("","",R) Quit
 Quit
 
VerwerkEenProduct(PR,UA,UZ) 
 New PC,PB,PLL,PSN,PKV,PNV,PGV,PLQ,ULT,Q15,USP,R,POSR,UAF
 New Aantal,Prijs,Korting1,Korting2,LevTerm
 Set $P(R,D,36)="",$P(R,D,2)=PR,$P(R,D,3)=UA,$P(R,D,31)=PakketNr
 Set K=^KPR(PR,0),PC=$P(K,D),PB=$P(K,D,5) Set:KB<1 PB=0
 Set X=^KPR(PR,1),PSN=$P(X,D,20) Quit:'$$IsCommAkt^PRODUKT2(PR,KC) ""
 S UAF=$P(^KOD(KC,US,UR,1),D,22)
 G P1:'UAF
 N IsOrgal,OrgalPr
 S IsOrgal=$$ISORGAL^FLOW("O",UR)
 G P1:IsOrgal=""
 S OrgalPr=$E($$SORTKEY^PRODUKT(PR,1),3,4)="OL"
 I IsOrgal,'OrgalPr D OpmEnkelOrgalux Q ""
 I 'IsOrgal,OrgalPr D OpmGeenOrgalux Q ""
P1 Lock (^KOD(KC,US,UR),^KPR(PR)):2 Else  Do OpmProductInGebruik Goto P1
 Set PID=$P(^KPR(PR,2),D,25)
 If $E(PID)=8&(UTYP="") Do  If K="" Set FP=2103 Write @F,@F1
 .New R
 .Set FP=UL*100+1 Write @F,@F1 Do ##class(CHUI.ToolKit).ProductHoofding(19,PR)
 .Set FP=2103 Write @F,$P($T(T1),U,2)
 .Set R="K\22\3\"_$P($T(T2),U,2)_"\"""_$P($T(T3),U,2)_"""\1\\"".""[K"
 .Do ^READ
 .Quit:K=""
 .Kill B Set UTYP=$S(UTYP="":"K",1:""),B(1)=^KOD(KC,US,UR,1),$P(B(1),D,25)=UTYP,^(1)=B(1)
 .Set U2="",X=100 For  Set X=$O(^KOD(0,US,X)) Quit:X'?.N  Set U2=^(X) If $P(U2,U,16)=125 Quit
 .If U2="" Kill B Quit
 .Set (K,U3)=UTYP If $L($P(U2,U,8)) Set U3="Set U3="_$P(U2,U,8) Xecute U3
 .Set FP=$P(U2,U,5)*100+$P(U2,U,6) Write @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13))
 .Write @F,U3
 .Set U2="",X=100 For  Set X=$O(@("^"_Q_UGL_"(0,US,X)")) Quit:X'?.N  Set U2=^(X) If $P(U2,U,16)="UR" Quit
 .If U2="" Kill B Quit
 .Set FP=$P(U2,U,5)*100+$P(U2,U,6)+$L(UR) Write @F," "
 .If $L(K) Write @F,@FMTB,@FMTK,$P("\s\c\a\k\m\p",D,$F("SCAKMP",K)),@FMTb,@FMTk
 .Kill B
 If $E(PID)=8,UTYP="" D OpmNormaalGeen8Producten Quit ""
 If 'PSN,UTYP="A" D OpmAfroepEnkelStock Quit ""
 ;If PSN,UTYP="C" D OpmContractGeenStock Quit ""
 ;If $E(PID)'=8,UTYP="K" Do OpmKlantgebondenEnkel8Producten Quit ""
 Set UZ=UZ-100
 Set Q15="^(""W    0.0""_UOR_UOD_$J(UR,6,0)_$J(UZ,3,0))"
 Set K="J",K=$O(^KPR(PR,K))
 Set K=^KPR(PR,K)
 Set PLQ=$P(K,D,6),PLL=$P(K,D,7),PGV=$P(K,D,16),PNV=$P(K,D,15),PKV=$P(K,D,14)
 If $H#7'=4,'PSN,PLL=1,$E($N(^KPR(PR,"J")),2,9)=5005,$E(PID)'=7 Set PLL=2
 If 'PGV Do OpmProductZonderGrootverpakking Quit ""
 Set UA=$P(R,D,3) If 'UA Do
 .Set UA=$S('PSN:PGV,PKV:PKV,PNV:PNV,1:PGV)
 .If 'PSN Set UA=$S(UA'<PLQ:UA,1:PLQ+PGV-(PLQ#PGV))
 .Set $P(R,D,3)=UA
 S ULT=$$INTDATE^vhLib.DataTypes(%WK,"DW") S:'PSN ULT=ULT+(PLL+1*7) S ULT=$$EXTDATE^vhLib.DataTypes(ULT,"DW")
 S POSR=$P(^KPR(PR,0),D,10) I $L(POSR),$E(POSR,$L(POSR))'=" " S POSR=POSR_" "
 Set ($P(R,D),$P(R,D,11))=$S($L(POSR):POSR,1:PO),$P(R,D,8)=PB,$P(R,D,12)="L"
 Set $P(R,D,17)="KF0",$P(R,D,24)=1,$P(R,D,25)=ULT
 Set $P(R,D,23)="",$P(R,D,27)="",$P(R,D,28)=""
 Set R=$$BerekenPrijs(R) If R="" Quit R
 New UVM,UTYP,UOD,UOR
 Set R=$$BerekenNetto(R)
 Set UZ=^KOD(KC,US,UR,0)-100
 Set Aantal=$P(R,D,3),Prijs=$J($P(R,D,9)/Aantal,0,##class(APPS.VKP.OrderlijnPrijsBepaler).GeefAantalDecimalen())
 Set Korting1=$P($P(R,D,7),"#")
 Set Korting2=$P($P(R,D,7),"#",2)
 Set LevTerm=$P(R,D,25)
 Set LevTerm="" If $D(DefLevT) Set LevTerm=DefLevT
 Do PINSERT^FLOWORD("","",PR,Aantal,Prijs,Korting1,Korting2,LevTerm)
 Set FP=$P(UD,D,2)+1*100+1 Write @F,@F1
 Quit ""
 
BerekenPrijs(X) 
 New PK1,PK2,PPL,KPC,AFA,AFR,AFE,PLP,PVK,UMC,UEP
 Set PR=$P(X,D,2)
 Set K=^KPR(PR,1),PSN=$P(K,D,20)
 Set K=$N(^KPR(PR,"J")),K=^KPR(PR,K)
 Set PLL=$P(K,D,7),UMC=$P(K,D,17) If "I"[UMC Do OpmProductZonderMunt Quit ""
 Set R=$$KLANTPR^KPRIJS(KC,PR)
 Set UEP=$P(R,D,1),UMC=$P(R,D,2),AFA=$P(R,D,3),PLP=$P(R,D,4),PK1=$P(R,D,5),PK2=$P(R,D,6),KKD=$P(R,D,7)
 Set PKP=$P(R,D,8),UPAR=$P(R,D,9),USP=$P(R,D,10),AFE=$P(R,D,11)
 Set $P(X,D,6)=$J($S(KKN:PLP,1:UEP),0,##class(APPS.VKP.OrderlijnPrijsBepaler).GeefAantalDecimalen())
 Set $P(X,D,7)=PK1_"#"_PK2
 Set $P(X,D,21)=USP
 Set $P(X,D,22)=UMC
 Quit X
 
BerekenNetto(R) 
 New PK1,PK2,UA,UEP,UN,UBE,AFE,UMC,K
 Set UA=$P(R,D,3),UEP=$P(R,D,6),PK1=$P($P(R,D,7),"#"),PK2=$P($P(R,D,7),"#",2)
 Set AFE=$E($P(R,D,21)),AFE=$P("1\100\1000",D,$F("EHM",AFE)-1)
 Set (UN,UBE)=$J(UEP/AFE*UA,1,##class(APPS.VKP.OrderlijnPrijsBepaler).GeefAantalDecimalen()) 
 If KKN { 
 	Set UN=$J(UEP*(100-PK1)/100*(100-PK2)/100*UA/AFE,1,##class(APPS.VKP.OrderlijnPrijsBepaler).GeefAantalDecimalen())
 }
 Set $P(R,D,9)=UN,$P(R,D,10)=UN,$P(R,D,16)=UBE
 Quit R
 
OpmMuntNietToegelaten Do ToonOpmerking("MUNT KLANT NIET TOEGELATEN VOOR "_UOU) Quit
OpmProductInGebruik Do ToonOpmerking("PRODUKT "_PC_" IN GEBRUIK") Quit
OpmProductZonderMunt Do ToonOpmerking("GEEN MUNTKODE VOOR PRODUKT "_PC) Quit
OpmProductZonderGrootverpakking Do ToonOpmerking("GEEN GROOTVERPAKKING VOOR PRODUKT "_PC) Quit
OpmNormaalGeen8Producten Do ToonOpmerking("EEN NORMAAL ORDER MAG GEEN 8-PRODUKTEN BEVATTEN") Quit
OpmAfroepEnkelStock Do ToonOpmerking("EEN AFROEP ORDER MAG ENKEL STOCKPRODUKTEN BEVATTEN") Quit
OpmContractGeenStock Do ToonOpmerking("EEN CONTRAKT ORDER MAG GEEN STOCKPRODUKTEN BEVATTEN") Quit
OpmKlantgebondenEnkel8Producten Do ToonOpmerking("EEN KLANTGEBONDEN ORDER KAN ENKEL 8-PRODUKTEN BEVATTEN") Quit
OpmEnkelOrgalux Do ToonOpmerking("EEN ORGALUX ORDER MAG ENKEL ORGALUX-PRODUKTEN BEVATTEN") Quit
OpmGeenOrgalux Do ToonOpmerking("EEN NIET-ORGALUX ORDER MAG GEEN ORGALUX-PRODUKTEN BEVATTEN") Quit
ToonOpmerking(MSG) 
 Set FP=2403+F60
 Write @F,@F2,@F4,MSG," [] = OK ",@F5,@F0
 Read K
 Quit
 
T1 ;DIT IS EEN 8-PRODUKT IN EEN NORMAAL ORDER !
T2 ;WENST U HIERVAN EEN KLANTGEBONDEN ORDER TE MAKEN
T3 ;.[] = ja   [] = neen