cI41	;Eenmalige conversie ivm vooruitbetalingen; cI41
	;
	G 1
	;
T0	;Eenmalige conversie ivm vooruitbetalingen;
	;
1	N I1,I2,I3,I4,DAT,BP,KC,PVLIJN,FILIJN,OMS,VNR,REK,FNR,US,LEN,UR
11	S $ZT="TRAP^cAN000"
	;  Opzoeken rek. nummer waarop in ^_Q_FI wordt geboekt.
13	S REK=$P($G(@("^"_Q_"BA(20,1)")),D)
	;  Aflopen van ^_Q_PV (winkelverkopen)
15	S I1=0
17	F  S I1=$O(@("^"_Q_"PV(I1)")) Q:I1=""  D
	. W !,I1
	. ;  Bepalen datum verrichting
	. S DAT=$$DCO^cAFD1(I1)
	. ;  Bepalen boekingsperdiode
	. S BP=$E(I1,1,4)_"."_$E(I1,5,6)
	. S I2=0
	. F  S I2=$O(@("^"_Q_"PV(I1,I2)")) Q:I2=""  D
	.. S I3=""
	.. F  S I3=$O(@("^"_Q_"PV(I1,I2,I3)")) Q:I3=""  D
	... S KC=$P(^(I3,1),D)
	... S MUNT=$P(^(1),D,7)
	... S I4=100
	... F  S I4=$O(@("^"_Q_"PV(I1,I2,I3,I4)")) Q:I4=""  D
	.... S PVLIJN=^(I4)
	.... ;  Enkel deze lijnen beschouwen die met voorschotten hebben te maken
	.... I $P(PVLIJN,D,12)'="Z"&($P(PVLIJN,D,12)'="ZZ") Q
	.... ;  Ophalen omschrijving
	.... S OMS=$P(PVLIJN,D,5)
	.... ; --- VJ - 20.12.02 --- vanuit TB klopt de omschrijving niet
	.... S OMS=$$UC^cAFA1(OMS)
	.... I $L(OMS," ")>2 D
	..... S $ZT="TRAP^cAN000"
	..... N Q,UGL,US,UR
	..... S Q=$P(PVLIJN,D,36) I Q="" Q
	..... S UGL=$P(PVLIJN,D,34) I UGL="" Q
	..... S US=$P(PVLIJN,D,35) I US="" Q
	..... S UR=$P(PVLIJN,D,33) I 'UR Q
	..... I '$D(@("^"_Q_UGL)@(0,US,"UDUO")) Q
	..... S OMS=$P(^("UDUO"),D,2)_" "_UR
	.... ;  Testen of de omschrijving niet langer is dan 15 pos., en desnoods eerste deel 
	.... ;  inkorten naar 8 pos.
	.... I $L(OMS)>15 D
	..... S $P(OMS," ")=$E($P(OMS," "),1,8)
	.... ;  Opzoeken van de overeenkomstige lijn in ^_Q_FI (beginnen vanaf datum verrichting)
	.... S VNR=I1_"0000",SWOK=0
	.... F  S VNR=$O(@("^"_Q_"FI(BP,REK,VNR)")) Q:VNR=""!(SWOK=1)  D
	..... S FILIJN=^(VNR)
	..... ;  Controle of programma, datum verrichting en omschrijving overeenkomen.
	..... I $P(FILIJN,D)'["FW44"!($P(FILIJN,D,2)'=DAT)!($P(FILIJN,D,9)'=OMS) Q
	..... ;  Controle of velden ivm UGL,KC,US en US nog niet zijn ingevuld.
	..... I $L($P(FILIJN,D,31))!($L($P(FILIJN,D,32)))!($L($P(FILIJN,D,33)))!($L($P(FILIJN,D,34))) Q
	..... ; Opzetten switch dat overeenkomstige lijn is gevonden.
	..... S SWOK=1
	..... ;  Invullen UGL-waarde
	..... S $P(FILIJN,D,31)=$P(PVLIJN,D,34)
	..... ;  Invullen KC
	..... S $P(FILIJN,D,32)=KC
	..... ;  Invullen US
	..... S $P(FILIJN,D,33)=$P(PVLIJN,D,35)
	..... ;  Invullen UR
	..... S $P(FILIJN,D,34)=$P(PVLIJN,D,33)
	..... ;  Terug wegschrijven van ^_Q_FI
	..... S @("^"_Q_"FI(BP,REK,VNR)")=FILIJN
	;
	;  Aflopen van ^_Q_FI en bij de facturen opzoeken van KC van ^_Q_UL en deze invullen bij ^_Q_FI
2	S I1=""
21	F  S I1=$O(@("^"_Q_"FI(I1)")) Q:I1=""  D
	. S I2=""
	. F  S I2=$O(@("^"_Q_"FI(I1,I2)")) Q:I2=""  D
	.. S I3=""
	.. F  S I3=$O(@("^"_Q_"FI(I1,I2,I3)")) Q:I3=""  D
	... S FILIJN=^(I3)
	... I $P(FILIJN,D)'["T256" Q
	... S FNR=$P(FILIJN,D,13)
	... I '$L(FNR) Q
	... S US=""
	... F  S US=$O(@("^"_Q_"FA(US)")) Q:US=""  D
	.... I '$D(@("^"_Q_"FA(US,FNR,0,0)")) Q
	.... S KC=$P(^(0),D,27)
	.... S $P(FILIJN,D,32)=KC
	.... S URSTR=""
	.... S UR="U"
	.... F  S UR=$O(@("^"_Q_"FA(US,FNR,UR)")) Q:UR=""!($E(UR)'="U")  D
	..... S URSTR=URSTR_(+$E(UR,2,99))_U
	.... S $P(FILIJN,D,34)=URSTR
	.... S @("^"_Q_"FI(I1,I2,I3)")=FILIJN
	;
YZ	Q
	;
ZZ	; 15.04.03 -  9 u 31 * V7.94