KF2L G 1 ;WIJZIGEN ORDERLIJNEN LEVERANCIERORDER; Go naar KF2AL [ 08/05/2002  10:44 AM ]
 ;
S1 S X=0
S1A S X=X+1,UP=$P(UUM,D,X) G S1Z:UP="",S1A:'$D(@$P(UP,U,1)) S FP=UL*100+1+$P(UVV,",",$P(UP,U,2)) W @F
S1B 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))) W:$P(UP,U,1)="UO" $E(BLA,1,$S($L(UO)<27:14,1:(40-$L(UO)))) G S1A
S1C W $J(@$P(UP,U,1),$P(UVV,",",($P(UP,U,2)+1))-$P(UVV,",",$P(UP,U,2))-1) G S1A
S1Z Q
 ;
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""" 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
M6 S MSG="DE LEVERTERMIJN VAN EEN NIET-STOCK PRODUKT IS NIET WIJZIGBAAR" G M0
 ;
1 S SWLPA=K,SW12=1,ULSV=UL K UZ
2 S X=^(1),UAF=$P(X,D,22)
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 G 43:'$D(UTA)!($N(UTA(0))=-1)
 S FP=2403+F60 W @F,"NUMMER v/d LIJN   -[] = TERUG NAAR ",$P(USM,U,3)," : ",@F0 R K
5 G 3:K?.E1C.E!(K="")!($P(K,"E",2)>29),43:K="-"!(K=",") S UVN=K+100
 I $D(UTA(K)) S UL=UTA(K),U2=@("^"_Q_UGL_"(KC,US,UR,UVN)") G M1:SWLPA="W"&$P(U2,D,2),M2:SWLPA'="W"&'$P(U2,D,2),9:"%F19KFVT"'[$P(U2,D,17)
7 S FP=2403+F60 W @F,@F2,@F4,"LIJN ",$P("ONBEKEND\NIET WIJZIGBAAR",D,$D(^(UVN))+1)," [] = OK ",@F5,@F0 R K G 3
9 S PR=$P(U2,D,2) G 39:'PR
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),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",'PSN,UAF G M6
13 S FP=1903+F60 W @F,@F1,$C(13),?2,"IDENTNR : ",?12,PID,?27,"PRODUKT  : ",PC
17 S X=$N(^("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 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 ^KF0268L
29 G 1^KF2AL
39 S FP=2103+F60 W @F,@F1,"WIJZIGEN ",K," : ",$P(U2,D,5)
41 D ^cF11 G 43:K=",",3:K="-" D S1 S U2=$P(U2,D,1,4)_D_UO_D_$P(U2,D,6,99),^(UVN)=U2 G 3
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 L @("^"_Q_UGL_"(KC,US,UR)") Q
 Q
Z X ^cZ Q
ZZ ; 12.10.90 - 15 u 19