KTRANS G 1 ;TRANSFERT ;KTRANS; [ 08/06/2002   8:39 AM ]
 ;
T1 ;PRODUKTEN
T2 ;PRODUKTENKUMUL
T3 ;PRODUKT-KLANTENKUMUL
T4 ;KLANTEN
T5 ;KLANT-PRODUKTEN
T6 ;KLANTENKUMUL
T7 ;KLANT-PRODUKTENKUMUL
T8 ;LEVERINGSADRESSEN
T9 ;UITZONDERINGEN
T10 ;EXPORT NEDERLAND
T11 ;BWT-LISTING
T21 ;TRANSFERT NUMMER
T22 ;x[] = bepaald nummer   x,x ... x,x[] = opeenvolgende nummers
T23 ;A[] = alle nummers
T24 ;WERDEN VOORBEREID  -  OP DATUM
T25 ;TE TRANSFEREREN
T26 ;OK VOOR BEGIN TRANSFERT\"[] = ok   ,[] = hernemen"
T32 ;TRANSFERTBESTAND IN GEBRUIK  [] = ok 
IMPORT ;1;C;L;;;|\2;C;L;;;|\3;N.;L;;;|\4;N.;L;;;|\5;N.;L;;;|\6;C;L;;;|\7;N.;L;;1;|\8;N.;L;;;|\9;N.;L;;;|\
EXPORT ;10;C;L;;;|\11;C;L;;;|\12;N.;L;;;|\13;N.;L;;;|\14;C;L;;;|\15;N.;L;;1;|\16;N.;L;;;|\17;N.;L;;;
 ;
S12 S DL(1)="LD",LD(1)="^KTRANS(12",LD(2)=$P($T(IMPORT),U,2,999)_$P($T(EXPORT),U,2,999)
 K ^KTRANS(12,0)
 D ^OUTPUT("T","","")
 K ^KTRANS(12)
 G YZ
 ;
YZ K ^HULP($J) Q
 ;
1 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
10 L @("^"_Q_"TRANS"):2 E  S FP=2403+F60 W @F,@F2,@F4,$P($T(T32),U,2),@F5,@F0 R K G YZ
BREAK1 B 1
11 S FP=301 W @F,@F1,$C(13),!?5,$P($T(T24),U,2),!
12 F I=1:1:15 Q:'$L($T(@("T"_I)))  S FP=I*100+501 W @F,$J(I,3),". " I $D(@("^"_Q_"TRANS(I,0)")) W $P($T(@("T"_I)),U,2) S FP=FP+27 W @F,$P(^(0),D,1) I $L($P(^(0),D,2)) S FP=FP+9 W @F,$P(^(0),D,2)
13 S R="BST\22\3\"_$P($T(T21),U,2)_"\C1\15\\K'="",""&$L(K)" D R0 G YZ:K="-"
14 I K="A" S BST="" F I=1:1:15 I $D(@("^"_Q_"TRANS(I,0)")) S BST=BST_I_","
15 S K=0 F I=1:1:16 Q:'$L($P(BST,",",I))  I '$P(BST,",",I)!($P(BST,",",I)>15)!'$D(@("^"_Q_"TRANS($P(BST,"","",I),0)")) S K=1
17 G 13:K,13:'$L(BST),13:$L($P(BST,",",I,99)) S FP=301 W @F,@F1,$C(13),!?5,$P($T(T25),U,2),!
19 F I=1:1:15 Q:'$L($P(BST,",",I))  S FP=I*100+501 W @F,$J(I,3),". ",$P($T(@("T"_$P(BST,",",I))),U,2) I $L($P(@("^"_Q_"TRANS($P(BST,"","",I),0)"),D,2)) S FP=FP+27 W @F,$P(^(0),D,2)
 If $P(BST,",")=12 G S12
2 S R="K\22\3\"_$P($T(T26),U,2)_"\1\\""-,""[K" D R0 G 11:$L(K) S K="" I 841[$P(BST,",",1) S K="+"
21 S X=$P(BST,",",1) G 3:'$L(X) S X=$D(@("^"_Q_"TRANS(X,1)")),X=0
23 S X=$N(^(X)) I X=-1 K @("^"_Q_"TRANS($P(BST,"","",1))") S BST=$P(BST,",",2,99) G 21
25 S K=K_^(X) G 29:X#1 I $P(BST,",",1)=11 W K S K="" G 23
26 I 841[$P(BST,",",1) W !
27 E  W $C(13)
28 I $P(BST,",",1)=10 S K=$TR(K,",",$C(9)) W $TR(K,".",",") S K="" G 23
29 W K S K="" G 23
3 W "~"
 G YZ
 ;
R0 S R7=1 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,$E("........................................",1,R6),@F,@F0
R0D R K W @F2 I $L(K)'>R6,K'[D&(K'?.E1C.E),@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  ;V5 02.01.86
 ;
C1 W !?2,$P($T(T22),U,2),!?2,$P($T(T23),U,2) Q
 ;