KFCOPY ; MODULE COPIEREN OFFERTE-, ORDERLIJNEN; Quit naar %F10 [ 09/24/2003   2:14 PM ]
 ;
T1 ;DIT ORDER IS REEDS GESLOTEN, COPY ONMOGELIJK
T2 ;COPIEREN ;OFFERTE;ORDER; : ; - VAN KLANT : 
T3 ;DIT IS GEEN DETAILOFFERTE
T4 ;C[] = COPIEREN DEFINITIEF
T5 ;DIT ORDER IS NOG NIET GESLOTEN
T6 ;VERMENIGVULDIGINGSFACTOR
T7 ;[] = 1
T8 ;DIT IS EEN 8-PRODUKT IN EEN NORMAAL ORDER !
T9 ;WENST U HIERVAN EEN KLANTGEBONDEN ORDER TE MAKEN
T10 ;.[] = ja   [] = neen
T11 ;DIT IS EEN LEVERANCIERSORDER, COPY ONMOGELIJK
T12 ;NETTO;BRUTO
T13 ;DE HUIDIGE PRIJZEN ZIJN 
T14 ;DE TE COPIEREN PRIJZEN ZIJN 
T15 ;ALLE PRIJZEN ZULLEN HERREKEND WORDEN
T16 ;C[] = copieren   -[] = hernemen
 ;
M1 S MSG="MUNT KLANT NIET TOEGELATEN VOOR "_UOU G MY
M3 S MSG="ER IS GEEN LEVERANCIER GEOPEND VOOR PRODUKT "_PC G MY
M5 S MSG="PRODUKT "_PC_" IN GEBRUIK" G MY
M6 S MSG="GEEN MUNTKODE VOOR PRODUKT "_PC G MY
M8 S MSG="GEEN GROOTVERPAKKING VOOR PRODUKT "_PC G MY
M9 S MSG="EEN NORMAAL ORDER MAG GEEN 8-PRODUKTEN BEVATTEN" G MY
M10 S MSG="EEN AFROEP ORDER MAG ENKEL STOCKPRODUKTEN BEVATTEN" G MY
M11 S MSG="EEN CONTRAKT ORDER MAG GEEN STOCKPRODUKTEN BEVATTEN" G MY
M12 S MSG="EEN KLANTGEBONDEN ORDER KAN ENKEL 8-PRODUKTEN BEVATTEN" G MY
M15 S MSG="EEN ORGALUX ORDER MAG ENKEL ORGALUX-PRODUKTEN BEVATTEN" G MY
M16 S MSG="EEN NIET-ORGALUX ORDER MAG GEEN ORGALUX-PRODUKTEN BEVATTEN" G MY
MY S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K
MZ Q
 ;
OFF S K=$$SELECT("OFKL","OFKL1") G YZ:K="-" D COPY("OFKL",KCO,K,KC'=KCO) G YZ  
ORD S K=$$SELECT("OD","O1") G YZ:K="-" D COPY("OD",KCO,K,KC'=KCO) G YZ  
 ;
SELECT(GL,GLI) 
 N Locals
 S R=^KOD(KC,US,UR,1) I $P(R,D,22) S S=$P($T(T1),U,2) X ^cTXT(0,"N",89) R K Q "-"
 I $P(R,D,25)="L" S S=$P($T(T11),U,2) X ^cTXT(0,"N",89) R K Q "-"
 F  D  Q:K="-"  S URO=K,KCO=$P(@("^K"_GLI_"(URO,""F"")"),D) Q:$D(@("^K"_GL_"(KCO,""F"",URO,1)"))
 .S Locals("GL")=Q_GL,Locals("GLI")=Q_GLI,Locals("UGL")=UGL
 .D XECUTE^vhPROGRAM("S Locals=$$SELECT^FLOW(GL,GLI,1)")
 .S K=Locals
 I K="-" Q K
 S UVM=$P(R,D,18),UTYP=$P(R,D,25) I '$$CHKMUNT^FLOW(UVM) D M1 Q "-"
 S UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(R,D,2)),"DS"),D,"")
 S UOR=$P("R\O",D,$P(R,D,17)+1)
 S R=@("^K"_GL_"(KCO,""F"",URO,1)")
 I GL="OFKL",'$P(R,D,9) S S=$P($T(T3),U,2) X ^cTXT(0,"N",89) R K Q "-"
 I GL="OD",'$P(R,D,22) S S=$P($T(T5),U,2) X ^cTXT(0,"N",89) R K Q "-"
 S FP=1801 W @F,@F1,!!?2,$P($T(T2),U,2),$P($T(T2),U,$F("FD",$E(GL,2))+1),$P($T(T2),U,5),URO
 W $P($T(T2),U,6),$P(^KKL(^KK1(KCO),0),D,2)
 Q URO
 ;
COPY(GL,KCO,URO,RC)
 New CopyOffOrOrd
 Set CopyOffOrOrd=1
 I $P(@("^K"_GL_"(KCO,""F"",URO,1)"),D,27)'=$P(^KOD(KC,US,UR,1),D,27) D  Q:K="-"
 .W !?2,$P($T(T13),U,2),$P($T(T12),U,KKN+2)
 .W !?2,$P($T(T14),U,2),$P($T(T12),U,'KKN+2)
 .S R="K\23\3\"_$P($T(T15),U,2)_"\"""_$P($T(T16),U,2)_"""\1\\""-C""[K&$L(K)" D R0^cA100
 .S RC=1,FP=2103 W @F,@F1
C1 S R="VFA\22\3\"_$P($T(T6),U,2)_"\"""_$P($T(T7),U,2)_"""\3\\K?.N&K!(""-""[K)"
 D R0^cA100 Q:K="-"  S FP=2301 W @F,@F1 I K="" S VFA=1,FP=2206+$L($P($T(T6),U,2)) W @F,1
 S R="K\24\3\"_$P($T(T4),U,2)_"\\1\\""-C""[K&$L(K)" D R0^cA100 G C1:K="-"
 S UZ=^KOD(KC,US,UR,0),UZO=100
 K DefLevT,DefLevM
 I $O(^KOD(KC,US,UR,100))="" D TYPE($P(@("^K"_GL_"(KCO,""F"",URO,1)"),D,25))
 I $P(^KOD(KC,US,UR,1),D,25)="C" S R=$$DEFLEVT(),DefLevT=$P(R,D)
 F  S UZO=$O(@("^K"_GL_"(KCO,""F"",URO,UZO)")) Q:UZO=""  D
 .S FP=$P(UD,D,2)+1*100+1 W @F,@F1
 .S R=@("^K"_GL_"(KCO,""F"",URO,UZO)"),R=$$REORG(R,GL,RC,UZ) Q:R=""
 .S ^KOD(KC,US,UR,UZ)=R
 .S UZ=UZ+1
 I KC=KCO,'$L($P(^KOD(KC,US,UR,1),D,3)) D
 .S K=$P(@("^K"_GL_"(KCO,""F"",URO,1)"),D,3)
 .S $P(^KOD(KC,US,UR,1),D,3)=K,R=100
 .F  S R=$O(^KOD(0,US,R)) Q:R'?.N  I $P(^KOD(0,US,R),U,16)=103 S R=^KOD(0,US,R) Q
 .I $P(R,U,16)=103 S FP=$P(R,U,5)*100+$P(R,U,6) W @F,K
 S:GL="OFKL" $P(^KOFKL(KCO,"F",URO,1),D,28)="B"
 Q
 ;
REORG(R,GL,RC,UZ) 
 I GL="OFKL" D  Q R
 .I $P($P(R,D,17),"#",1,2)="KOF1925#CK" D  S R="" Q
 ..New ActieCode,CKPRNr,CKValidate
 ..Quit:$$BevatCommKort^FLOWMANL("KOD",KC,ORDNr)
 ..Set ActieCode=$P($P(R,D,17),"#",4)
 ..Set:$L(ActieCode) CKPRNr=$P($G(^RES("FLOW","PI","MANLIJNAC","D",ActieCode)),"`",4),CKValidate=$P($G(^RES("FLOW","PI","MANLIJNAC","D",ActieCode)),"`",6)
 ..If $G(CKPRNr),$L(CKValidate) Xecute "Set CKValidate=$$"_CKValidate_"(KC,CKPRNr)" Quit:'CKValidate
 ..S ($P(R,D),$P(R,D,11))=PO,$P(R,D,8)=$S(KB<1:0,1:8) ; Opbrengstrekening en btw-code
 ..S:$P($P(R,D,17),"#",3) ($P(R,D,9),$P(R,D,10),$P(R,D,16))="0.00"
 ..S $P(R,D,17)="KF1925#"_$P($P(R,D,17),"#",2,4)
 ..D MINSERT^FLOWORD("","",R)
 ..S FP=$P(UD,D,2)+1*100+1
 ..W @F,@F1
 .I "\KOF11\KOF0\"'[(D_$P($P(R,D,17),"#")_D) S R="" Q
 .I $P($P(R,D,17),"#")="KOF11" S $P(R,D,17)="KF11#1", $P(R,D,18)=$P($H,",",2)_";T;;OBF"
 .;  JCL --> poging tot wijzigen van 18de veld info gekoppelde tekstlijnen ... --> OLUNr ...  --> voorlopig nikske aan doen tot wanneer ze bij OV te veel zagen :D
 .; I $P($P(R,D,17),"#")="KOF11" S $P(R,D,17)="KF11#1", R18=$P(R,D,18),$P(R,D,18)=$P($H,",",2)_";"_$P(R18,";",2,3)_";OBF"
 .I $P(R,D,2) S R=$$PRODUKT(R,GL,RC,UZ) Q
 .D TINSERT^FLOWORD("","",R)
 .S FP=$P(UD,D,2)+1*100+1
 .W @F,@F1
 .S R=""
 I GL="OD" D  Q R
 .I "\KF11\KF0\"'[(D_$P($P(R,D,17),"#")_D) S R="" Q
 .I $P(R,D,2) S R=$$PRODUKT(R,GL,RC,UZ) Q
 .D TINSERT^FLOWORD("","",R)
 .S FP=$P(UD,D,2)+1*100+1
 .W @F,@F1
 .S R=""
 Q ""
 ;
PRODUKT(R,GL,RC,UZ) 
 N PR,PC,PB,PLL,PSN,PKV,PNV,PGV,PLQ,ULT,UA,Q15,USP,AFE,POSR,UAF
 N Aantal,Prijs,Korting1,Korting2,LevTerm,OrdMunt,LijnMunt
 S PR=$P(R,D,2) Q:'$D(^KPR(PR)) ""
 S K=^KPR(PR,0),PC=$P(K,D),PB=$P(K,D,5) S:KB<1 PB=0
 S:KB<1 PB=0 S X=^KPR(PR,1),PSN=$P(X,D,20) Q:'$$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 M15 Q ""
 I 'IsOrgal,OrgalPr D M16 Q ""
P1 L (^KOD(KC,US,UR),^KPR(PR)):2 E  D M5 G P1
 S OrdMunt=$P(^KOD(KC,US,UR,1),D,18) Set:OrdMunt="" OrdMunt=$$FADEF^vhRtn1()
 S PID=$P(^KPR(PR,2),D,25)
 S RTEMP=R
 I $E(PID)=8&(UTYP="") D  I K="" S FP=2103 W @F,@F1
 .S FP=UL*100+1 W @F,@F1 S FP=1903+F60 W @F,$C(13),?2,"IDENTNR : ",PID,?27,"PRODUKT  : ",PC
 .S FP=2103 W @F,$P($T(T8),U,2)
 .S R="K\22\3\"_$P($T(T9),U,2)_"\"""_$P($T(T10),U,2)_"""\1\\"".""[K" D R0^cA100
 .Q:K=""
 .K B S UTYP=$S(UTYP="":"K",1:""),B(1)=^KOD(KC,US,UR,1),$P(B(1),D,25)=UTYP,^(1)=B(1)
 .S U2="",X=100 F  S X=$O(^KOD(0,US,X)) Q:X'?.N  S U2=^(X) I $P(U2,U,16)=125 Q
 .I U2="" K B Q
 .S (K,U3)=UTYP I $L($P(U2,U,8)) S U3="S U3="_$P(U2,U,8) X U3
 .S FP=$P(U2,U,5)*100+$P(U2,U,6) W @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13))
 .W @F,U3
 .S U2="",X=100 F  S X=$O(@("^"_Q_UGL_"(0,US,X)")) Q:X'?.N  S U2=^(X) I $P(U2,U,16)="UR" Q
 .I U2="" K B Q
 .S FP=$P(U2,U,5)*100+$P(U2,U,6)+$L(UR) W @F," "
 .I $L(K) W @F,@FMTB,@FMTK,$P("\s\c\a\k\l\y\m\p",D,$F("SCAKLYMP",K)),@FMTb,@FMTk
 .K B
 I $E(PID)=8,UTYP="" D M9 Q ""
 I 'PSN,UTYP="A" D M10 Q ""
 ;I PSN,UTYP="C" D M11 Q ""
 ;I $E(PID)'=8,UTYP="K" D M12 Q ""
 S R=RTEMP,UZ=UZ-100
 S Q15="^(""W    0.0""_UOR_UOD_$J(UR,6,0)_$J(UZ,3,0))"
 S K="J",K=$O(^KPR(PR,K)) I $E(K)'="J" D M3 Q ""
 S K=^KPR(PR,K)
 S 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)
 I $H#7'=4,'PSN,PLL=1,$E($N(^KPR(PR,"J")),2,9)=5005,$E(PID)'=7 S PLL=2
 I 'PGV D M8 Q ""
 S UA=$P(R,D,3) I 'UA D
 .S UA=$S('PSN:PGV,PKV:PKV,PNV:PNV,1:PGV)
 .I 'PSN S UA=$S(UA'<PLQ:UA,1:PLQ+PGV-(PLQ#PGV))
 .S $P(R,D,3)=UA
 S UA=UA*VFA,$P(R,D,3)=UA
 S ULT=$$INTDATE^vhDTyp(%WK,"DW") S:'PSN ULT=ULT+(PLL+1*7) S ULT=$$EXTDATE^vhDTyp(ULT,"DW")
 S POSR=$P(^KPR(PR,0),D,10) I $L(POSR),$E(POSR,$L(POSR))'=" " S POSR=POSR_" "
 S ($P(R,D),$P(R,D,11))=$S($L(POSR):POSR,1:PO),$P(R,D,8)=PB,$P(R,D,12)="L"
 S $P(R,D,17)="KF0",$P(R,D,24)=1,$P(R,D,25)=ULT
 S $P(R,D,23)="",$P(R,D,27)="",$P(R,D,28)=""
 I RC S R=$$CALCEP(R) I R="" Q R
 N UVM,UTYP,UOD,UOR
 S R=$$CALCNET(R),AFE=$E($P(R,D,21)),AFE=$P("1\100\1000",D,$F("EHM",AFE)-1)
 S UZ=^KOD(KC,US,UR,0)-100
 S Aantal=$P(R,D,3),Prijs=$J($P(R,D,9)/Aantal*AFE,0,2),Korting1=$P($P(R,D,7),"#"),Korting2=$P($P(R,D,7),"#",2)
 S LijnMunt=$P(R,D,22) Set:LijnMunt="" LijnMunt=$$FADEF^vhRtn1()
 I OrdMunt'="MTL",LijnMunt'=OrdMunt Set Prijs=$$MUNT^vhRtn1(LijnMunt,5,Prijs_"#1",,OrdMunt)
 S LevTerm="" I $D(DefLevT) S LevTerm=DefLevT
 D PINSERT^FLOWORD("","",PR,Aantal,Prijs,Korting1,Korting2,"",1,"",$S(RC:"",1:1))
 S FP=$P(UD,D,2)+1*100+1 W @F,@F1
 Q ""
 ;
CALCEP(X) 
 N PK1,PK2,PPL,KPC,AFA,AFR,AFE,PLP,PVK,UMC,UEP
 S PR=$P(X,D,2)
 S K=^KPR(PR,1),PSN=$P(K,D,20)
 S K=$N(^KPR(PR,"J")),K=^KPR(PR,K)
 S PLL=$P(K,D,7),UMC=$P(K,D,17) I "I"[UMC D M6 Q ""
 S R=$$KLANTPR^KPRIJS(KC,PR)
 S 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)
 S PKP=$P(R,D,8),UPAR=$P(R,D,9),USP=$P(R,D,10),AFE=$P(R,D,11)
 S $P(X,D,6)=$J($S(KKN:PLP,1:UEP),0,2),$P(X,D,7)=PK1_"#"_PK2,$P(X,D,21)=USP,$P(X,D,22)=UMC
 Q X
 ;
CALCNET(R) 
 N PK1,PK2,UA,UEP,UN,UBE,AFE,UMC,K
 S UA=$P(R,D,3),UEP=$P(R,D,6),PK1=$P($P(R,D,7),"#"),PK2=$P($P(R,D,7),"#",2)
 S AFE=$E($P(R,D,21)),AFE=$P("1\100\1000",D,$F("EHM",AFE)-1)
 S (UN,UBE)=$J(UEP/AFE*UA,1,2) I KKN S UN=$J(UEP*(100-PK1)/100*(100-PK2)/100*UA/AFE,1,2)
 S $P(R,D,9)=UN,$P(R,D,10)=UN,$P(R,D,16)=UBE
 Q R
 ;
TYPE(Type) 
 N U2,K,A,X
 Q:"\C\K\A\"'[(D_Type_D)
 Q:$P(^KOD(KC,US,UR,1),D,25)=Type
 S (K,X)=100,UTYP=Type
 F  S X=$O(^KOD(0,US,X)) Q:X'?.N!(X>200)  S K=K+1,A(K)=^KOD(0,US,X)
 S U2=""
 F  S U2=$O(A(U2)) Q:U2=""  I $P(A(U2),U,16)="UR" Q
 I $L(U2) S U2=A(U2)
 I $P(U2,U,16)="UR" D
 .S FP=$P(U2,U,5)*100+$P(U2,U,6)+$L(UR)
 .W @F,@FMTB,@FMTK,$P("\c\a\k",D,$F("CAK",Type)),@FMTb,@FMTk
 S U2=""
 F  S U2=$O(A(U2)) Q:U2=""  I $P(A(U2),U,16)=125 Q
 I $L(U2) S U2=A(U2)
 I $P(U2,U,16)=125 D
 .S FP=$P(U2,U,5)*100+$P(U2,U,6)
 .W @F,$J("",$P(U2,U,9)+$P(U2,U,13))
 .W @F,$P("\CONTRACT\AFROEP\KLANT(8)",D,$F("CAK",Type))
 S $P(^KOD(KC,US,UR,1),D,25)=Type
 Q
 ;
DEFLEVT() 
 N R,X,W
 Quit "" ; CW 17.05.2010
 S X=100,W=""
 F  S X=$O(@("^K"_GL_"(KCO,""F"",URO,X)")) Q:X=""  D
 .S R=@("^K"_GL_"(KCO,""F"",URO,X)")
 .I $P(R,D,25)>W S W=$P(R,D,25)
 I $L(W) D
 .S R=@("^K"_GL_"(KCO,""F"",URO,1)"),R=$$INTDATE^vhDTyp($P(R,D,2))
 .S:R<$H R=+$H
 .S W=$$EXTDATE^vhDTyp($$CALCDATE^vhDTyp(R,"W",W,"LD"),"DW")
 Q W
 ;
YZ K AFA,AFE,AFR,KPC,GR,OGR,BGR,KKD,UPAR,MSG,PKP,PLL,PST,PB,PLQ,PC,PR,PK1,PK2,PLP,PPL,PID,PRE,PSN,PVK,PGV,PNV,PKV,PY,Q15
 K S,SW25,UE,UN,UAF,UOD,UOR,UVM,ULTT,ULTE,X,UTYP,UIMP,L24,URO,KCO,UZO,RTEMP L ^KOD(KC,US,UR) Q
 ;