KFA12 ;BEHEER LEVERINGSADRESSEN ;Do van %FA13,%FA14 [ 11/08/2003  3:05 PM ]
 G 1
 ;
T1 ;KLANT
T2 ;DE KLANT
T3 ;\KLANT NR. 
T4 ;\\\WERD VERWIJDERD\\\\\
T5 ;NAAM OF NUMMER VAN 
T6 ;   [] = vervolg
T7 ;LEVERINGSADRES :
T8 ;.[] = manueel   [] = andere klant als leveringsadres
T80 ;*[] = manueel via andere klant
 
 ;
1 N FG,F7,F8
 Set F7="$C(27),""(0""",F8="$C(27),""(B"""
 S FG="*108\*107\*109\*106\*119\*117\*116\*118\*113\*120\*110\*108\*107\*109\*106\*119\*117\*116\*118\*113\*120\*110\"
 D E^cA612
 S PNT="........................................",SL="\\\\\\\\\\\\\\\\\\\\\\\\\\",U=";",Q1="^"_Q_"K1(KC)",SW1=0,SW2=1
3 D S1
5 S X=@("^"_Q_"KL(0,0)"),X=10,K=100
 D S3
7 S X=$N(^(X)) G 13:X<0!(X>99) S U2=^(X),K=K+1,A(K)=U2
11 G 7
 ;
13 I $G(Extern) S KI1=^KK1(KC) G 17
 S FP=2001 W @F,@F1
 S KC=$$SELECT^KLANT6()
 G YZ:'KC S KI1=^KK1(KC)
 S FP=2001 W @F,@F1
15 L @Q1:2 E  X ^cTXT(0,"N",60) R K G 13
17 S LAC="" D S2
21 S K=$$SELECT^LEVADR(KC,"NR")
 I K="" G 13:'$G(Extern),YZ
 I K="N" F K=1:1 Quit:'$D(^KKL(KI1,"L"_$J(K,3)))
 ;
 D
 .N FG,F7,F8
 .D O^cA612(1,1,24,80,0,0,0,0)
 ;
33 K KCL S SW7=0,KI2="L"_$J(K,3),FP=2001 W @F,@F1 S LAC=K
 D S1,S2
35 I '$D(@("^"_Q_"KL(KI1,KI2)")) S B(1)=SL D S3 D ^cFA13 G 41
 D S3
37 D ^cFA14 S SW1=1
 ;
41 S FP=2001 W @F,@F1
 D E^cA612
 G 21
 ;
YZ Q
 ;
S0 S FP=2203+F60 W @F,@F1,$P($T(T7),";",2),!?2,$P($T(T8),";",2),!?2,$P($T(T80),";",2)
S0A S FP=2220+F60 W @F,@F0 R K S KCM=K I "*"'[K G S0Z:"-.,"[K&$L(K),S0:K'=""
S0B D E^cA612 S K=$$SELECT^KLANT6(),FP=2101 W @F,@F1
 G S0:'K S K=^KK1(K)
 G S0B:K=KI1 S B(0)=^KKL(K,0)
 I KCM'="*" S KCL=K,K=$P(B(0),D,1)
 E  S $P(B(1),D,2,9)=$P(B(0),D,2,9),$P(B(1),D,13,14)=$P(B(0),D,13,14),$P(B(1),D,15)=$P(^KKL(K,1),D,24),K="."
S0Z Q
 ;
S1 N K
 S K=$P($T(+1),U,2)_QN_" ",FP=203+$L(K) W @F61,@F11,@F1,@F,@F5 S FP=202 W @F,@F4,K,@F5
 Q
 ;
S2 N U2
 S FP=408 W @F,@F5 S FP=402 W @F,@F6,$P($T(T1),";",2),@F5," : "
 S U2=@("^"_Q_"KL(KI1,0)"),FP=412 W @F,@F2,$P(U2,D,1)," ",$P(U2,D,4)," ",$P(U2,D,2)
 S FP=512 W @F,@F2,$P(U2,D,5) S FP=612 W @F,@F2,$$LAND^vhRtn1($P(U2,D,8)) W:$L($P(U2,D,8)) "   " W $P(U2,D,6),"   ",$P(U2,D,7) D S3
 Q
 ;
S3 N U1,U2
 S U1=100,SW1=0
S3A S U1=$N(A(U1))
 I U1>0 D  G S3A
 . S U2=A(U1)
 . S FP=$P(U2,U,2)*100+$P(U2,U,3) W:$P(U2,U,22) @F,$J(U1#100,2) I '$P(U2,U,23) S FP=FP+2 W @F,@F6,$P(U2,U,1),@F9
 . S FP=$P(U2,U,5)*100+$P(U2,U,6) I '$P(U2,U,23) S FP=FP-3 W @F,@F9,":"
 . S FP=$P(U2,U,5)*100+$P(U2,U,6) W @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13))
S3Z Q
 ;
S4 N U1,U2,U3,K,X
 S U1=""
 F  S U1=$O(A(U1)) Q:U1=""  D
 .S U2=A(U1),X=$P(U2,U,16) S:'$D(B(X\100)) B(X\100)="\\\\\\\\\\\\\\\\\\\\\\\\\" S (K,U3)=$P(B(X\100),D,X#100) I $L($P(U2,U,8)) X "S U3="_$P(U2,U,8)
 .S FP=$P(U2,U,5)*100+$P(U2,U,6)
 .W:SW1 @F,$J("",$P(U2,U,9)),$J("",$P(U2,U,13)) W @F,U3
 Q
 ;
R1 S R4=$P(R,D,2)+1,R0=0,RA=$P(R,D,3),R8="^"_Q_$P(R,D,4),R9="^"_Q_$P(R,D,5),FP=R4 W @F,@F1
R1A X ^cTXT(0,"N",15)
R1B R K G R1A:K?.E1C.E!(K?20N.N) S:$L(K) R0=0 S FP=R4 W @F,@F1 G R1Z:K="-" I K="" S R1=R4 G R1H:R0,R1D
R1C G R1D:K'?.N,R1K:'$D(@(R9_"(K)")) S R3=^(K) I $D(@(R8_"(R3)")) G R1M
R1D S R6="" F R7=1:1:99 I $E(K,R7)'?1P S R6=R6_$E(K,R7)
R1E S R5=$E(R6,1,24) S:R6="" R5=" " S R1=R4,R2=R5,(R2,R3)=$N(@(R8_"(R2)")) G R1K:R2=-1 S R2=$N(^(R2))
R1F I $E(R2,1,$L(R6))'=R6&'R0&($E(R3,1,$L(R6))=R6) S R7=$D(^(R3)) G R1M
R1G S R2=R5
R1H S R2=$N(@(R8_"(R2)")) G R1K:($E(R2,1,$L(R6))]R6)&'R0&(R1=R4) G R1L:R2=-1 I $E(R2,1,$L(R6))'=R6 S R0=0 G R1A
R1I S FP=R1 W @F,$C(13),$J(+^(R2,0),6),?7,$E($P(^(0),D,2),1,26),?34,$E($P(^(0),D,5),1,26),?61,$E($P(^(0),D,7),1,18)
R1J S R1=R1+100 G R1H:R1<(2300+F60) S R0=1 G R1A
R1K X ^cTXT(0,"N",8) R K
R1L S (R2,R0)=0 G R1A
R1M S (@$P(R,D,1),K)=R3
R1Z K R0,R1,R2,R3,R4,R5,R6,R7,R8,R9,RA Q  ;V4 23.05.85
 ;
Extern(KLNr)
 New KC,Extern
 Set (KC,Extern)=KLNr
 Goto 1
 ;
 ; Ingave adrestype
AdresType
 New AdresType,zb,R,U2,X
 If $G(K)'="-" Do
 .D E^cA612
 .Set K=$P(B(1),D,12)
 .For  Set AdresType=$$PI^vhPOPUP("C;C","-1OA","","KLANT","ADRESTYPE",$S(K="":"L",1:K)),zb=$G(zb) Quit:zb="CANC"  Quit:$$CheckAdresTypes(AdresType)
 .Set K=$S(zb="CANC":"-",AdresType="L":"",1:AdresType)
 .D
 ..N FG,F7,F8
 ..D O^cA612(1,1,24,80,0,0,0,0)
 .D S1,S2,S4
 Quit
 ;
 ; Controle op ingave adrestype
CheckAdresTypes(AdresType)
 New AdresTypeOk,LevAdr,KlKey
 Set AdresTypeOk=1,LevAdr="L",KlKey=^KK1(KC)
 If AdresType="F"!(AdresType="B") Do  ; Verzendadres factuur of Bezoekadres (mag niet dubbel)
 . For  Set LevAdr=$O(^KKL(KlKey,LevAdr)) Quit:$E(LevAdr)'="L"  If $P(^KKL(KlKey,LevAdr),D)'=$P(B(1),D) Set AdresTypeOk=($P(^KKL(KlKey,LevAdr),D,12)'=AdresType) Quit:'AdresTypeOk
 . If 'AdresTypeOk Do WARN^vhTXTPOP("Er bestaat reeds een adres van~het type '"_$P(^RES("KLANT","PI","ADRESTYPE","D",AdresType),"`",2)_"'.","")
 Quit AdresTypeOk
 ;
 ; Mag een popupitem getoond worden?
CBADRESTYPE(Item)
 New Include
 If '$D(^KKL(KI1,KI2)) Do  ; Indien nieuw adres
 . New R,KI2
 . Do:$P(Item,"`")="B" ; Er mag slechts een bezoekadres ingegeven worden
 . . Set KI2="L"
 . . For  Set KI2=$O(^KKL(KI1,KI2)) Quit:$E(KI2)'="L"  Do  Quit:'Include
 . . . Set R=^KKL(KI1,KI2),Include=$P(R,"\",12)'="B"
 . Do:$P(Item,"`")="F" ; Er mag slechts een verzendadres factuur ingegeven worden
 . . Set KI2="L"
 . . For  Set KI2=$O(^KKL(KI1,KI2)) Quit:$E(KI2)'="L"  Do  Quit:'Include
 . . . Set R=^KKL(KI1,KI2),Include=$P(R,"\",12)'="F"
 Quit $G(Include,1)
 ;
AantalAdressen
 New R,KLNr,LevCount,BezCount
 Set KLNr=$P($G(B(1)),D,1)
 If $L(KLNr),$D(^KK1(KLNr)) Do
 . Set U3="L",(LevCount,BezCount)=0
 . For  Set U3=$O(^KKL(^KK1(KLNr),U3)) Quit:$E(U3)'="L"  Do
 . . Set R=^KKL(^KK1(KLNr),U3)
 . . If $P(R,D,12)="B" Set BezCount=BezCount+1
 . . Else  Set LevCount=LevCount+1
 . Set U3="ja ("_LevCount_"/"_BezCount_")"
 ;