KTWL G 1 ;WIJZIGEN LIJNEN TOELEVERINGEN [ 08/07/2002   4:17 PM ]
 ;
S1 S X=0
S1A S X=X+1,UP=$P(TUM,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),$E(BLA,1,$P(UVV,",",($P(UP,U,2)+1))-$P(UVV,",",$P(UP,U,2))-1-$L(@$P(UP,U,1))) 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
M3 S MSG="ER IS GEEN LEVERANCIER GEOPEND VOOR DIT PRODUKT" G M0
M4 S MSG="DE LEVERANCIER DIT PRODUKT IS VERSCHILLEND VAN DE TOELEVERING" G M0
M5 S MSG="PRODUKT IN GEBRUIK" G M0
 ;
R0 S R7="K'[D&(K'?.E1C.E)" S:$P(R,D,8)'="" R7=R7_"&("_$P(R,D,8)_")" S:$P(R,D,7)'="" R7=R7_"&("_$P($T(@$P(R,D,7))," ",2,99)_")"
R0A S R2=$P(R,D,2),R3=$P(R,D,3),R4=$P(R,D,4),R5=$P(R,D,5),R6=$P(R,D,6)
R0B S R0=$L(R4)+R3+3 S FP=R2*100+R3+F60 W @F W:R3<4 @F1 W @F2,R4," : " I R5'="" W:R5["""" !,?2,@R5 D:R5'["""" @R5
R0C S FP=R2*100+R0+F60 W @F,@F2 W $E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,@R7 S @$P(R,D,1)=K
R0E E  G R0C
R0F S FP=$P(R,D,9)*100+($P(R,D,10)*1) I FP W @F,$J("",R6),@F,K
R0Z K R,R0,R2,R3,R4,R5,R6,R7 Q  ;V4 03.10.84
 ;
1 S SWLPA=K,SW12=1,ULSV=UL K UZ I $G(ScrolToe) S K=UVN-100
 S Q15="^KPR(PR,""W    0.0T""_TOD_$J(TR,6,0)_$J((UVN-100),3,0))"
 S Q16="^KPR(PR,""W    0.0R""_UOD_$J(UR,6,0)_$J((UUZ-100),3,0))"
2 S X=@("^"_Q_UGL_"(LC,TR,1)")
 S TOD=$TR($$EXTDATE^vhDTyp($$INTDATE^vhDTyp($P(X,D,2)),"DS"),D,"")
 S UI=$P(X,D,2),UJ=$P(X,D,3)
3 K UA,UO S FP=$P(UD,D,2)+1*100+1 W @F,@F1 I '$G(ScrolToe) G 43:'$D(UTA)!($N(UTA(0))=-1) S FP=2403+F60 W @F,"Nummer v/d te wijzigen lijn : ",@F0 R K
5 G 3:K?.E1C.E!(K=""),43:K="-"!(K=","),3:K'?.N S UVN=K+100
 I $D(UTA(K))!$G(ScrolToe) S:'$G(ScrolToe) UL=UTA(K) S U2=@("^"_Q_UGL_"(LC,TR,UVN)") G 9:$P(U2,D,17)'="%F19",YZ:$G(ScrolToe)
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
10 L (@("^"_Q_UGL_"(LC,TR)"),@("^"_Q_"PR(PR)")):2 E  G M5
11 S UA=0,X=@("^"_Q_"PR(PR,0)"),PC=$P(X,D,1),PST=$P(X,D,14),PY=$P(X,D,17)
12 S X=^(1),PSN=$P(X,D,20),X=^(2),PRE=$P(X,D,9),PID=$P(X,D,25)
13 I '$G(AutoInp) S FP=1903+F60 W @F,@F1,$C(13),?2,"IDENTNR : ",?12,PID,?27,"PRODUKT  : ",PC
17 S X=$N(^("J")) G M3:$E(X,1,1)'="J",M4:$E(X,2,99)'=LC S X=^(X),PLQ=$P(X,D,6),PGV=$P(X,D,16)
19 S UEP=$P(U2,D,6),PK1=$P($P(U2,D,7),"#",1),PK2=$P($P(U2,D,7),"#",2),USP=$P(U2,D,21),PA=UEP-(UEP*PK1/100),PA=PA-(PA*PK2/100)
21 S UMC=$P(U2,D,22),ULT=$P(U2,D,25),ULTA=$P(U2,D,29)
27 I '$G(AutoInp) S R=PSN_D_(PST-$P(PRE,"#",2))_D_($P(PY,"#",2)-$S('$P(U2,D,27):$P(U2,D,3),1:0))_D_ULT_D_PLQ_D_UEP_D_PK1_D_PK2_D_PA_D_UMC_D_USP_D_PGV_D D ^KTRWL
29 G 1^KTWL1
39 I SWLPA'="W" S K="-" G YZ
 S FP=2103+F60 W @F,@F1
 I $G(ScrolToe) S UO=$$SCROL^KTO11($P(U2,D,5),1) G YZ:UO="-" S $P(U2,D,5)=UO,@("^"_Q_UGL_"(LC,TR,UVN)")=U2 G YZ
41 S UO=$$SCROL^KTO11($P(U2,D,5),1) G 43:K=",",3:K="-" D S1 S U2=$P(U2,D,1,4)_D_UO_D_$P(U2,D,6,99),@("^"_Q_UGL_"(LC,TR,UVN)")=U2 G 3
43 S UL=ULSV
 ;
YZ K UO,U2,UR,UUZ,KC,UN,UMC,MSG,PGV,PST,PC,PR,PID,PRE,PSN,PY,PK1,PK2,Q15,Q16,UA,UK,UEP,UBE,TOD,UOD,UOR,ULT,ULTA,U26,X
 K OrdLevT
 L @("^"_Q_"TO(LC,TR)") Q
 Q
 ;
SCROL(UVN,K,AutoInp) 
 G 1
 ;