KF2 G 1 ;WIJZIGEN ORDERLIJNEN; Go naar KF2A [ 07/11/2003  2:35 PM ]
 ;
M0 S FP=2403+F60 W @F,@F2,@F4,MSG," [] = OK ",@F5,@F0 R K G YZ
M1 S MSG="PRODUKTLIJNEN WIJZIGEN VIA ""L"", ""P"" OF ""A""" S UL=ULSV G M0
M2 S MSG="TEKST- OF MANUELE LIJNEN WIJZIGEN VIA ""W""" G M0
M3 S MSG="ER IS GEEN LEVERANCIER GEOPEND VOOR DIT PRODUKT" G M0
M5 S MSG="PRODUKT IN GEBRUIK" G M0
M7 S MSG="IMPULS WIJZIGEN ENKEL VOOR EEN CONTRACT-ORDER" G M0
 ;
1 N OspWk,BrutoPr,ProjRef
 S SWLPA=K,SW12=1,ULSV=UL K UZ S K=UVN-100
2 S X=@("^"_Q_UGL_"(KC,US,UR,1)"),BrutoPr=$P(X,D,27)
 S UOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
 S UOR=$P("R\O",D,$P(X,D,17)+1),UAF=$P(X,D,22)
 S UTYP=$P(X,D,25) G YZ:UTYP="L"
 S Q15="^(""W    0.0""_UOR_UOD_$J(UR,6,0)_$J((UVN-100),3,0))",Q16="^(""W    0.0T""_UOD_$J(TR,6,0)_$J((TUZ-100),3,0))"
3 L @("^"_Q_UGL_"(KC,US,UR)")
4 K UA,UO,UEP,UBE,UIMP,U30 S FP=$P(UD,D,2)+1*100+1 W @F,@F1
 I SWLPA="B",UTYP'="C" G M7
5 G 3:K?.E1C.E!(K="")!($P(K,"E",2)>29),43:K="-"!(K=",") S UVN=K+100
 S U2=@("^"_Q_UGL_"(KC,US,UR,UVN)") G M1:SWLPA="W"&$P(U2,D,2),YZ:SWLPA'="W"&'$P(U2,D,2)&$L($G(AutoInp)),M2:SWLPA'="W"&'$P(U2,D,2),9:"%F19KFVT"'[$P(U2,D,17),YZ
9 S PR=$P(U2,D,2) G 39:'PR
10 L (@("^"_Q_UGL_"(KC,US,UR)"),@("^"_Q_"PR(PR)")):2 E  G M5
11 S PK1=$P($P(U2,D,7),"#",1),PK2=$P($P(U2,D,7),"#",2),ULT=$P(U2,D,25),ULTT=$P(U2,D,29)
112 S AFRR=$P(U2,D,21),AFA=$E(AFRR,1),AFR=$E(AFRR,2),AFE=$P("1\100\1000",D,$F("EHM",AFA)-1)
 S ProjRef=$P(U2,D,5),UEP=$P(U2,D,6) S:BrutoPr UEP=$J($P(U2,D,9)/$P(U2,D,3)*AFE,1,2)
12 S X=@("^"_Q_"PR(PR,0)"),PC=$P(X,D,1),(PST,PPS)=$P(X,D,14),PY=$P(X,D,17),X=^(1),PSN=$P(X,D,20),X=^(2),PRE=$P(X,D,9),PID=$P(X,D,25),PPS=PPS-$P(PRE,"#",2) S:'$P(U2,D,27) PPS=PPS+$P(U2,D,3)
 I SWLPA="L" D
 .Q:'UAF
 .I PSN,'$L($P(U2,D,28)) Q
 .S OspWk=$P(U2,D,29),ULTT="" S:OspWk="" OspWk=ULT
 .Q:$P($P(U2,D,28),";")
 .I 'PSN D
 ..S AskTekst=$$ASKTEKST(UR)
 ..K:'AskTekst AskTekst
13 I '$L($G(AutoInp)) S FP=1903+F60 W @F,@F1,$C(13),?2,"IDENTNR : ",?12,PID,?27,"PRODUCT  : ",PC
17 S X=$N(@("^"_Q_"PR(PR,""J"")")) I $E(X,1,1)'="J" G M3
19 S X=^(X)
 S R=$$KLANTPR^KPRIJS(KC,PR),UMC=$P(R,D,2),PLP=$P(R,D,4),CIFP=$P(R,D,13)*AFE
21 S UPAR=$$MUNT^vhRtn1(UMC,,12)
27 I '$L($G(AutoInp)) S R=PSN_D_PPS_D_$P(PY,"#",2)_D_$P(X,D,6)_D_ULT_D_$P(X,D,14,16)_D_UMC_D_AFA_D_PLP_D_PK1_D_PK2_D_D_UEP_D_D_$P(X,D,7)_D_PST_D_ULTT_D D ^KF0268
29 G 1^KF2AD
39 D
 .I $P($P(U2,D,17),"#")'="KF1925" S UO=$$SCROL^KF11($P(U2,D,5),1) Q
 .N B D WIJZIG^FLOWMANL("KOD",KC,UR,UVN) S UO="-"
 G YZ:UO="-" S $P(U2,D,5)=UO,@("^"_Q_UGL_"(KC,US,UR,UVN)")=U2 G YZ
43 S UL=ULSV S:K="," K="-"
 ;
YZ K LC,TR,TUZ,GR,AFA,AFE,AFR,AFRR,UMC,UPAR,MSG,PST,PPS,PC,PR,PLP,CIFP,PID,PRE,PSN,PY,PK1,PK2,PGV,PNV,PKV,S,Q15,Q16
 K UA,UE,UK,UEP,UBE,UOD,UOR,ULT,ULTT,U26,UAF,X,SWLPA,UIMP,U30,UTYP,OspWk
 L @("^"_Q_UGL_"(KC,US,UR)") Q
 ;
SCROL(UVN,K,AutoInp) 
 G 1
 ;
ASKTEKST(ORDNr) 
 New KLNr,OLNr,NoAsk
 Set KLNr=$P(^KO1(ORDNr,"F"),D),OLNr=100,NoAsk=0
 For  Set OLNr=$O(^KOD(KLNr,"F",ORDNr,OLNr)) Quit:'OLNr  Do  Quit:NoAsk
 .Set NoAsk=$P($P(^KOD(KLNr,"F",ORDNr,OLNr),D,17),"#")="KF11"
 Q 'NoAsk
 ;