cI93	;Hernummeren van de leveranciers (enkel boekhouding); %I93 [ 08/20/2002  12:10 PM ]
	;
	G 1
	;
T0	;Hernummeren van de leveranciers (enkel boekhouding!);
T1	;Q-waarde;
T2	;Hernummeren vanaf\"xxxxxx = huidig leveranciersnummer +/- xxxxxx";
T3	;Nieuw leveranciersnummer = leveranciersnummer ;
T4	;Bevestiging\".[] = ok";
T5	;Einde hernummering leveranciers.;
T6	;Keuze\"[] = bijtellen   1[] = aftrekken";
	;
1	D P^cA612(2,1,20,80,1,0,1,1,$P($T(@("T0"_QT)),U,2),0,0,7,1,1)
11	N QQ,NNR,BEV,UI1,NUI1,LENR,NLENR,NAAM,I1,I2,I3,I4,INH,X,Y,USA,UQA
13	S $ZT="TRAP^cAN000"
	;  Vraagstelling voor welke Q-waarde
15	S R="QQ\22\3\"_$P($T(@("T1"_QT)),U,2)_"\C1\3\\$L(K)&(""-""[K!($$QWRD^cI93(K)))\\\1\\1" D R0
16	I QQ="-" G YZ
17	W /CUP(2,2),@F6,$P($T(@("T1"_QT)),U,2),@F9," : ",QQ
	; Vraagstelling naar de hernummering
19	S R="NNR\22\3\"_$P($T(@("T2"_QT)),U,2)_"\7\\$L(K)&(""-""[K!(K?.N))\\\\\1" D R0
	;
2	I NNR="-" G 15
21	S R="TEKEN\22\3\"_$P($T(@("T6"_QT)),U,2)_"\1\\K=""1""!(K=""-"")!(K="""")\\\\\1" D R0
23	I TEKEN="-" G 19
25	W /CUP(4,3),$P($T(@("T3"_QT)),U,2),$S(TEKEN="":"+ ",1:"- "),NNR
27	S R="BEV\22\3\"_$P($T(@("T4"_QT)),U,2)_"\1\\$L(K)&(K="".""!(K=""-""))" D R0
28	I BEV="-" G 21
29	I TEKEN=1 S NNR="-"_NNR
	;
	;  Hernummeren van de leveranciers
3	K ^TEMPC($T(+0),QQ) 
	;  Aflopen van het leveranciersbestand
31	S UI1=0
33	F  S UI1=$O(@("^"_QQ_"LE(UI1)")) Q:UI1=""  D
	. S LENR=$P(^(UI1,0),D)
	. W /CUP(17,2),@F2,LENR
	. S NAAM=$P(^(0),D,2)
	. S NLENR=LENR+NNR
	. I $D(^TEMPC($T(+0),QQ,"LE",LENR)) Q
	. S $P(@("^"_QQ_"LE(UI1,0)"),D)=NLENR
	. S NUI1=$$DI^cAN000(NAAM,NLENR)
	. M @("^"_QQ_"LE(NUI1)")=@("^"_QQ_"LE(UI1)")
	. S ^TEMPC($T(+0),QQ,"LE",NLENR)=LENR_D_NLENR
	. K @("^"_QQ_"LE(UI1)")
	. S @("^"_QQ_"L1(NLENR)")=NUI1
	. K @("^"_QQ_"L1(LENR)")
	. ; Hernummeren logging
	. M ^DLOG(QQ,"LE",NLENR)=^DLOG(QQ,"LE",LENR)
	. K ^DLOG(QQ,"LE",LENR)
	. ; Hernummeren TXT
	. M ^DTXT(QQ,"LE",NLENR)=^DTXT(QQ,"KL",LENR)
	. K ^DTXT(QQ,"LE",LENR)
	; Hernummeren ^DIN
34	S ^DIN(QQ,"LE")=$G(^DIN(QQ,"LE"))+NNR
	;  Controle indexen leveranciers
35	N Q S Q=QQ
38	D DMS^cAN000("UQC","USC","LE")
39	D S1^cAN002(UQC,USC,17,0)
	;
	; Hernummeren contactpersonen
4	S I1=""
41	F  S I1=$O(^DATA(QQ,"CP",I1)) Q:I1=""  D
	. W /CUP(17,2),@F2,I1
	. I '$L($P(^(I1,1),D,21)) Q
	. S $P(^(1),D,21)=$P(^(1),D,21)+NNR
	;  Controle indexen contactpersonen
43	D DMS^cAN000("UQC","USC","CP")
45	D S1^cAN002(UQC,USC,17,0)
	;
	; Hernummeren leveranciersbetalingen 
5	S I1=""
51	F  S I1=$O(@("^"_QQ_"L3(I1)")) Q:I1=""  D
	. S I2=""
	. F  S I2=$O(@("^"_QQ_"L3(I1,I2)")) Q:I2=""  D
	.. S I3=""
	.. F  S I3=$O(@("^"_QQ_"L3(I1,I2,I3)")) Q:I3=""  D
	... W /CUP(17,2),@F2,I3
	... I $D(^TEMPC($T(+0),QQ,"L3",I3)) Q
	... S I4=""
	... F  S I4=$O(@("^"_QQ_"L3(I1,I2,I3,I4)")) Q:I4=""  D
	.... S INH=^(I4)
	.... S $P(INH,D)=$P(INH,D)+NNR
	.... S @("^"_QQ_"L3(I1,I2,I3,I4)")=INH
	... S NLENR=I3+NNR
	... M @("^"_QQ_"L3(I1,I2,NLENR)")=@("^"_QQ_"L3(I1,I2,I3)")
	... S ^TEMPC($T(+0),QQ,"L3",NLENR)=I3_D_NLENR
	... K @("^"_QQ_"L3(I1,I2,I3)")
53	S I1=""
54	F  S I1=$O(^DATA(QQ,"BVB",I1)) Q:I1=""  D
	. S I2=0
	. F  S I2=$O(^DATA(QQ,"BVB",I1,I2)) Q:I2=""  D
	.. W /CUP(17,2),@F2,I2
	.. S INH=^(I2)
	.. I '$L($P(INH,D)) Q
	.. S $P(INH,D)=$P(INH,D)+NNR
	.. S ^DATA(QQ,"BVB",I1,I2)=INH
55	S I1=""
56	F  S I1=$O(^DATA(QQ,"BVB.LE",I1)) Q:I1=""  D
	. S I2=""
	. F  S I2=$O(^DATA(QQ,"BVB.LE",I1,I2)) Q:I2=""  D
	.. W /CUP(17,2),@F2,I2
	.. S INH=^(I2)
	.. I '$L($P(INH,D)) Q
	.. S $P(INH,D)=$P(INH,D)+NNR
	.. S ^DATA(QQ,"BVB.LE",I1,I2)=INH
58	S I1=""
59	F  S I1=$O(^DATA(QQ,"BVB.LE.B",I1)) Q:I1=""  D      
	. S I2=""
	. F  S I2=$O(^DATA(QQ,"BVB.LE.B",I1,I2)) Q:I2=""  D
	.. W /CUP(17,2),@F2,I2
	.. S INH=^(I2)
	.. I '$L($P(INH,D)) Q
	.. S $P(INH,D)=$P(INH,D)+NNR
	.. S ^DATA(QQ,"BVB.LE.B",I1,I2)=INH
	;
	;  Herrekenen betalingsvoorstel leverancier
6	S I1=""
61	F  S I1=$O(^DATA(QQ,"BVS",I1)) Q:I1=""  D
	. S I2=0
	. F  S I2=$O(^DATA(QQ,"BVS",I1,I2)) Q:I2=""  D
	.. W /CUP(17,2),@F2,I2
	.. S INH=^(I2)
	.. I '$L($P(INH,D)) Q
	.. S $P(INH,D)=$P(INH,D)+NNR
	.. S ^DATA(QQ,"BVS",I1,I2)=INH
63	S I1=""
65	F  S I1=$O(^DATA(QQ,"BVS.LE",I1)) Q:I1=""  D
	. S I2=""
	. F  S I2=$O(^DATA(QQ,"BVS.LE",I1,I2)) Q:I2=""  D
	.. W /CUP(17,2),@F2,I2
	.. S INH=^(I2)
	.. I '$L($P(INH,D)) Q
	.. S $P(INH,D)=$P(INH,D)+NNR
	.. S ^DATA(QQ,"BVS.LE",I1,I2)=INH
	;
	;  Hernummeren Kumul zakencijfers opstarten leveranciers
68	S I1=0
69	F  S I1=$O(@("^"_QQ_"L9(I1)")) Q:I1=""  D
	. W /CUP(17,2),@F2,I1
	. I $D(^TEMPC($T(+0),QQ,"L9",I1)) Q
	. S NLENR=I1+NNR
	. M @("^"_QQ_"L9(NLENR)")=@("^"_QQ_"L9(I1)")
	. S ^TEMPC($T(+0),QQ,"L9",NLENR)=I1_D_NLENR
	. K @("^"_QQ_"L9(I1)")
	;
	;  Hernummeren aankoopdagboek en ventilaties
7	S I1=""
71	F  S I1=$O(@("^"_QQ_"AA(I1)")) Q:I1=""  D
	. S I2=""
	. F  S I2=$O(@("^"_QQ_"AA(I1,I2)")) Q:I2=""  D
	.. W /CUP(17,2),@F2,I2
	.. I I2["." Q
	.. S INH=^(I2)
	.. I $L($P(INH,D,4)) S $P(INH,D,4)=$P(INH,D,4)+NNR
	.. S @("^"_QQ_"AA(I1,I2)")=INH
	;
	;  Hernummeren openstaande aankoopfacturen
73	S I1=""
75	F  S I1=$O(@("^"_QQ_"AF(I1)")) Q:I1=""  D
	. W /CUP(17,2),@F2,I1
	. S $P(^(I1),D)=$P(^(I1),D)+NNR
	;
	;  Hernummeren financieel
78	S I1=""
79	F  S I1=$O(@("^"_QQ_"FI(I1)")) Q:I1=""  D
	. S I2=""
	. F  S I2=$O(@("^"_QQ_"FI(I1,I2)")) Q:I2=""  D
	.. S I3=""
	.. F  S I3=$O(@("^"_QQ_"FI(I1,I2,I3)")) Q:I3=""  D
	... W /CUP(17,2),@F2,I3
	... S INH=^(I3)
	... I $P(INH,D,7)'="L" Q
	... S X=$P($P(INH,D,8),"#")
	... S Y=X+NNR_"#"_$P($P(INH,D,8),"#",2)
	... S $P(INH,D,8)=Y
	... S @("^"_QQ_"FI(I1,I2,I3)")=INH
	;
	; Hernummeren beginbalans verkoop
8	S I1=""
81	F  S I1=$O(@("^"_QQ_"AAB(I1)")) Q:I1=""  D
	. S I2=""
	. F  S I2=$O(@("^"_QQ_"AAB(I1,I2)")) Q:I2=""  D
	.. W /CUP(17,2),@F2,I2
	.. I $D(^TEMPC($T(+0),QQ,"AAB",I2)) Q
	.. S NLENR=I2+NNR
	.. M @("^"_QQ_"AAB(I1,NLENR)")=@("^"_QQ_"AAB(I1,I2)")
	.. S ^TEMPC($T(+0),QQ,"AAB",NLENR)=I2_D_NLENR
	.. K @("^"_QQ_"AAB(I1,I2)")
	;
	;  Hernummeren wissels
83	S I1=""
85	F  S I1=$O(@("^"_QQ_"WI(I1)")) Q:I1=""  D
	. I '$D(@("^"_QQ_"WI(I1,0)")) Q
	. S INH=^(0)
	. I $P(INH,D,6)'="LE" Q
	. S $P(INH,D,3)=$P(INH,D,3)+NNR
	. S @("^"_QQ_"WI(I1,0)")=INH
	;
	;  Hernummeren ingeschreven leveranciersfacturen
86	S I1=""
87	F  S I1=$O(@("^"_QQ_"LEFNR(I1)")) Q:I1=""  D
	. W /CUP(17,2),@F2,I1
	. I $D(^TEMPC($T(+0),QQ,"LEFNR",I1)) Q
	. S NLENR=I1+NNR
	. M @("^"_QQ_"LEFNR(NLENR)")=@("^"_QQ_"LEFNR(I1)")
	. S ^TEMPC($T(+0),QQ,"LEFNR",NLENR)=I1_D_NLENR
	. K @("^"_QQ_"LEFNR(I1)")
	;
	;  Hernummeren klanten
88	S UQA=$P($G(^DMS(QQ,"KL","DMA","W")),D),USA=$P($G(^("W")),D,2)
89	I UQA=""!USA="" G 9
	S I1=0
	F  S I1=$O(@("^"_QQ_"KL(I1)")) Q:I1=""  D
	. W /CUP(17,2),@F2,I1
	. I '$L($P(^(I1,2),D,30)) Q
	. S NLENR=$P(^(2),D,30)+NNR
	. D W^cAN220(USA,UQA,I1,330,NLENR)
	;
9	S K=$P($T(@("T5"_QT)),U,2) D TXT^cAFA1(250)
	;
YZ	D C^cA612 Q
	;
R0	S $P(R,D,12)=$T(+0) D ^cAN1000 Q
	;
C1	W !?2,$TR(^cLOG(boot,"Q","TST,"_boot),"\"," ") Q
	;
QWRD(K)	;  Inputcontrole op geldige Q-waarde
	N R,qq
	S $ZT="TRAP^cAN000"
	I '$L(K) S R=0 G QWRDZ
	S R=1
	S qq=^cLOG(boot,"Q","TST,"_boot)
	S qq=U_$TR(qq,"\",U)_U
	I qq'[(U_K_U) S R=0
QWRDZ	Q R
	;
ZZ	; 29.10.02 - 11 u 38 * V7.93