INTRAST ;INTRASTAT (N.I.S.) ; [ 04/08/2003  3:34 PM ]
 Goto BEGIN
 ;
 ; Ophalen produktgegevens
PRALG(PRNr) 
 New R
 Set (StatRef,Gewicht)="" Quit:'$D(^KPR(PRNr))
 Set R=^KPR(PRNr,1),Gewicht=$P(R,D,13)/1000
 Set R=^KPR(PRNr,2),StatRef=$P(R,D,8)
 Quit
PRLEV(PRNr) 
 New Munt,R
 Set R=$O(^KPR(PRNr,"J")) If $E(R)'="J" Set PPL=0 Quit
 Set R=^KPR(PRNr,R),LEVNr=$P(R,D),Korting=$P(R,D,9),PPL=$P(R,D,19),%CIF=$P(R,D,21)
 Set EenhAank=$S($P(R,D,28)="M":1000,$P(R,D,28)="H":100,1:1)
 Set Munt=$P(R,D,17) Set:Munt="" Munt=$$FADEF^vhRtn1()
 Set Pariteit=$$MUNT^vhRtn1(Munt,,12)
 Quit
 ;
 ; Ophalen landkode van klant of leverancier
LAND(Type,Ref,EEG) 
 New Land
 If Type="LE" Set Land=$P(^KLE(^KL1(Ref),0),D,8)
 Else  Set Land=$P(^KKL(^KK1(Ref),0),D,8)
 Set Land=$$LAND^vhRtn1(Land,,2)
 If "\B\L\"[(D_Land_D) Quit ""
 Quit:'$D(^INTRAST(1,Land)) ""
 Set Land=$P(^INTRAST(1,Land),D,2)
 If EEG="EEG",'$D(^INTRAST(0,Land)) Quit ""
 Quit Land
 ;
IMPORT ; Doorlopen van het produktenbestand
 New PRNr,HistNr,HistStr,Beweging,PPL,%CIF,EenhAank,Magazijn
 New Periode,LandHerk,LandOors
 New LosPla,PRNr,Datum,Aantal,Ref,Gewicht,StatNr,StatRef,Periode
 New VerzWijz,LEVNr,AardTra,Pariteit,AanvEenh,Korting
 Set PRNr=0,LosPla=""
 For  Set PRNr=$O(^KPR(PRNr)) Quit:PRNr=""  Do
 .Quit:$E($P(^KPR(PRNr,2),D,25))=6  ; Geen kinderen
 .Quit:$E($P(^KPR(PRNr,2),D,25))=7  ; Geen DO
 .Do PRALG(PRNr)
 .;Quit:StatRef=""!'Gewicht
 .;Quit:StatRef=""
 .Do PRLEV(PRNr)
 .Set LandHerk=$$LAND("LE",LEVNr,"EEG") Quit:LandHerk=""
 .Set LandOors=LandHerk,VerzWijz=3
 .Set R=$G(^INTRAST(2,StatRef_" "),"999999"),StatNr=$P(R,D),AanvEenh=$P(R,D,3)
 .Set HistNr=""
 .For  Set HistNr=$O(^PRHIST(PRNr,HistNr),-1) Quit:HistNr=""  Do
 ..Set HistStr=^PRHIST(PRNr,HistNr)
 ..Set Datum=$P(HistStr,D,9) Set:'Datum Datum=$P(HistStr,D)
 ..Set Beweging=$P(HistStr,D,4),Magazijn=$P(HistStr,D,5),Ref=$P(HistStr,D,7)
 ..Quit:Beweging'="I"  ; Geen inboeking
 ..If Magazijn'="M",Magazijn'="W",Magazijn'="K" Quit  ; Magazijn of werkvloer
 ..Set Periode=$$EXTDATE^vhLib.DataTypes(Datum,"DM4")
 ..Quit:Periode'=Maand
 ..Set AardTra=11,Aantal=$P(HistStr,D,2)
 ..If Aantal<0 Do NEGAANK Quit
 ..Do AANKOOP(LandHerk,LandOors,VerzWijz,LosPla,AardTra,StatNr,Aantal,Gewicht,AanvEenh)
 Quit
 ;
 ; Toelevering van goederen
AANKOOP(LandHerk,LandOors,VerzWijz,LosPla,AardTra,StatNr,Aantal,Gewicht,AanvEenh) 
 New StatStel,Key,NettoBed,NettoGew,StatWaa,FaktWaa
 Set StatStel=19
 If 'Pariteit Set Pariteit=1
 Set NettoBed=Aantal*PPL/EenhAank*(100-Korting/100)
 Set NettoGew=Aantal*Gewicht
 Set (StatWaa,FaktWaa)=NettoBed*Pariteit
 If AardTra=11 Set TotFaktA=TotFaktA+FaktWaa
 Else  Set FaktWaa=""
 If '$D(%CIF)
 Else  If %CIF Set StatWaa=StatWaa*1.03
 Else  Set StatWaa=StatWaa*.99
 ;Write:0'[$G(Dev) 
 ;W "A"_StatStel,$C(9),LandHerk,$C(9),LandOors,$C(9),VerzWijz,$C(9),AardTra,$C(9),StatNr,$C(9),PRNr,$C(9),$P($G(^KPR(PRNr,0)),D),$C(9),$TR(NettoGew,".",","),$C(9),$TR(FaktWaa,".",","),$C(9),$TR(StatWaa,".",","),$C(9),$TR(NettoBed,".",",")
 ;W $C(9),$TR(PPL,".",","),$C(9),Aantal,$C(9),Pariteit,$C(9),EenhAank,$C(9),$P(^KPR(PRNr,0),D),$C(9),$E($O(^KPR(PRNr,"J")),2,99),$C(9),$P(^KLE(^KL1($E($O(^KPR(PRNr,"J")),2,99)),0),"\",2)
 ;W *9,$P($P(HistStr,"\",11),"/"),*9,$P($P(HistStr,"\",11),"/",2)
 ;W !
 Do HULPAANK(StatStel,LandHerk,LandOors,VerzWijz,LosPla,AardTra,StatNr,Aantal,NettoGew,AanvEenh,StatWaa,FaktWaa) 
 Quit
 ;
HULPAANK(StatStel,LandHerk,LandOors,VerzWijz,LosPla,AardTra,StatNr,Aantal,NettoGew,AanvEenh,StatWaa,FaktWaa,LEVNr) 
 New R,Key
 Set LEVNr=$G(LEVNr,"9999")
 Set Key=LandHerk_LandOors_VerzWijz_LosPla_AardTra_StatNr
 If $D(^HULP($J,StatStel,Key)) Set R=^HULP($J,StatStel,Key)
 Else  Set R=LandHerk_D_LandOors_D_VerzWijz_D_LosPla_D_AardTra_D_StatNr
 Set $P(R,D,7)=$P(R,D,7)+NettoGew
 If AanvEenh Set $P(R,D,8)=$P(R,D,8)+Aantal
 Set $P(R,D,9)=$P(R,D,9)+StatWaa
 Set $P(R,D,10)=$P(R,D,10)+FaktWaa
 Set ^HULP($J,StatStel,Key)=R
 Quit
 ;
NEGAANK ; Toelevering - verwerking negatieve lijn
 New LandBest,LaadPla,NettoBed
 Set LandBest=LandHerk,LaadPla=""
 Set AardTra=21,Aantal=-Aantal,NettoBed=Aantal*PPL/EenhAank
 If '$D(%CIF)
 Else  If %CIF Set NettoBed=NettoBed*1.03
 Else  Set NettoBed=NettoBed*.99
 Do VERKOOP(LandBest,VerzWijz,LaadPla,AardTra,StatNr,Aantal,Gewicht,AanvEenh,NettoBed)
 Quit
 ;
EXPORT ; Doorlopen van de fakturen voor export
 New Periode,LandBest,LaadPla,IsEuro,EurDat,Munt
 New FANr,PRNr,Datum,Aantal,Gewicht,StatNr,StatRef,Lijn,LijnNr
 New VerzWijz,KLNr,ULNr,AardTra,Pariteit,Port,NettoBed,AanvEenh
 Set (KLNr,LaadPla)="",IsEuro=$$ISEURO^vhRtn1(),EurDat=$$INTDATE^vhLib.DataTypes($$FADEF^vhRtn1(11))
 For  Set KLNr=$O(^KFA1("F",KLNr)) Quit:KLNr=""  Do
 .Quit:'$D(^KK1(KLNr))
 .Set LandBest=$$LAND("KL",KLNr,"EEG") Quit:LandBest=""
 .Set Datum=""
 .For  Set Datum=$O(^KFA1("F",KLNr,Datum)) Quit:Datum=""  Do
 ..Set Periode=$$EXTDATE^vhLib.DataTypes(-Datum,"DM4")
 ..If Periode<Maand Set Datum=-10000 Quit
 ..If Periode'=Maand Quit
 ..Set FANr=""
 ..For  Set FANr=$O(^KFA1("F",KLNr,Datum,FANr)) Quit:FANr=""  Do
 ...Set R=^KFA("F",FANr,0,0) Quit:'$P(R,D,16)
 ...Set Pariteit=$P(R,D,4),Munt=$P(R,D,5),Port=$P($P(R,D,17),"#",2),Credit=$P(R,D,2)="C"
 ...If 'Pariteit Set Pariteit=1
 ...If IsEuro,-Datum<EurDat Set Pariteit=$$MUNT^vhRtn1(Munt,3,12)
 ...Set (Port,PFaktWaa)=Port*Pariteit
 ...Set:Credit TotFaktA=TotFaktA+Port
 ...Set:'Credit TotFaktV=TotFaktV+Port
 ...Set ULNr="U"
 ...For  Set ULNr=$O(^KFA("F",FANr,ULNr)) Quit:ULNr=""  Do
 ....Set Lijn=^KFA("F",FANr,ULNr,1),VerzWijz=$P($P(Lijn,D,7),"#")
 ....If $E(VerzWijz,$L(VerzWijz))=" " Set VerzWijz=$E(VerzWijz,1,$L(VerzWijz)-1)
 ....Set VerzWijz=$S(VerzWijz="SP":2,VerzWijz="DI1":2,VerzWijz="PO":5,1:3)
 ....Set LijnNr=100
 ....For  Set LijnNr=$O(^KFA("F",FANr,ULNr,LijnNr)) Quit:LijnNr=""  Do
 .....Set Lijn=^KFA("F",FANr,ULNr,LijnNr)
 .....Set PRNr=$P(Lijn,D,2) Quit:'PRNr
 .....Do PRALG(PRNr)
 .....Quit:StatRef=""!'Gewicht
 .....Set AardTra=11,Aantal=$P(Lijn,D,3),NettoBed=$P(Lijn,D,9)
 .....Set R=^INTRAST(2,StatRef_" "),StatNr=$P(R,D),AanvEenh=$P(R,D,3)
 .....If Aantal<0 Do NEGVERK Quit
 .....Do VERKOOP(LandBest,VerzWijz,LaadPla,AardTra,StatNr,Aantal,Gewicht,AanvEenh,NettoBed)
 Quit
 ;
 ; Fakturatie van goederen
VERKOOP(LandBest,VerzWijz,LaadPla,AardTra,StatNr,Aantal,Gewicht,AanvEenh,NettoBed) 
 New StatStel,Key,NettoGew,StatWaa,FaktWaa
 Set StatStel=29
 If 'Pariteit Set Pariteit=1
 Set NettoGew=Aantal*Gewicht
 Set (StatWaa,FaktWaa)=NettoBed*Pariteit
 If AardTra=11 Set TotFaktV=TotFaktV+FaktWaa
 Else  Set FaktWaa=""
 If $D(PFaktWaa) Set FaktWaa=FaktWaa+PFaktWaa Kill PFaktWaa
 If '$D(Port)
 Else  If Port Set StatWaa=StatWaa*1.01
 Else  Set StatWaa=StatWaa*.98
 Write:0'[$G(Dev) "V"_StatStel,$C(9),LandBest,$C(9),VerzWijz,$C(9),LaadPla,$C(9),AardTra,$C(9),StatNr,$C(9),PRNr,$C(9),$P($G(^KPR(PRNr,0)),D),$C(9),Aantal,$C(9),$TR(NettoGew,".",","),$C(9),AanvEenh,$C(9),$TR(StatWaa,".",","),$C(9),$TR(FaktWaa,".",","),$C(9),$TR(StatWaa,".",","),$C(9),$TR(NettoBed,".",","),!
 ;,$C(9),$TR($G(PPL),".",","),$C(9),Aantal,$C(9),Pariteit,$C(9),EenhAank,$C(9),$P(^KPR(PRNr,0),D),$C(9),$E($O(^KPR(PRNr,"J")),2,99),$P(^KLE(^KL1($E($O(^KPR(PRNr,"J")),2,99)),0),"\",2)!
 Do HULPVERK(StatStel,LandBest,VerzWijz,LaadPla,AardTra,StatNr,Aantal,NettoGew,AanvEenh,StatWaa,FaktWaa) 
 Quit
 ;
HULPVERK(StatStel,LandBest,VerzWijz,LaadPla,AardTra,StatNr,Aantal,NettoGew,AanvEenh,StatWaa,FaktWaa) 
 Set Key=LandBest_VerzWijz_LaadPla_AardTra_StatNr
 If $D(^HULP($J,StatStel,Key)) Set R=^HULP($J,StatStel,Key)
 Else  Set R=LandBest_D_D_VerzWijz_D_LaadPla_D_AardTra_D_StatNr
 Set $P(R,D,7)=$P(R,D,7)+NettoGew
 If AanvEenh Set $P(R,D,8)=$P(R,D,8)+Aantal
 Set $P(R,D,9)=$P(R,D,9)+StatWaa
 Set $P(R,D,10)=$P(R,D,10)+FaktWaa
 Set ^HULP($J,StatStel,Key)=R
 Quit
 ;
NEGVERK ; Fakturatie - verwerking negatieve lijn
 Set NettoBed=NettoBed*Pariteit
 New LandHerk,LandOors,LosPla,LEVNr,PPL,Pariteit,%CIF,EenhAank,FaktWaa,Korting
 Set FaktWaa=-NettoBed
 Do PRLEV(PRNr)
 Set LandOors=$$LAND("LE",LEVNr,"") If LandOors="" Set LandOors=$P(^INTRAST(1,"B"),D,2)
 Set LandHerk=LandBest,LosPla=""
 New Pariteit,%CIF,EenhAank
 Set TotFaktA=TotFaktA-NettoBed
 Set AardTra=21
 Do HULPAANK(19,LandHerk,LandOors,VerzWijz,LosPla,AardTra,StatNr,"","","","",FaktWaa) 
 Set Pariteit=1,PPL=NettoBed/Aantal,EenhAank=1,Aantal=-Aantal
 If Port Set PPL=PPL*1.01
 Else  Set PPL=PPL*.98
 Do AANKOOP(LandHerk,LandOors,VerzWijz,LosPla,AardTra,StatNr,Aantal,Gewicht,AanvEenh)
 Quit
 ;
COPYTR ; Copy naar het transfertbestand
 New Count,ImpKey,ExpKey,Import,Export,AantImpL,AantExpL
 New TotImpFa,TotExpFa,AardTra,StatWaa
 Set (Count,ImpKey,ExpKey)="",(AantImpL,AantExpL,TotImpFa,TotExpFa)=0
 Set ImpKey=$O(^HULP($J,19,ImpKey))
 Set ExpKey=$O(^HULP($J,29,ExpKey))
C1 Set Import="" If ImpKey'="" Set Import=^HULP($J,19,ImpKey)
 If $P(Import,D,7) Set $P(Import,D,7)=$P(Import,D,7)*10+.99999\1/10
 If Count If '$P(Import,D,7)!'$P(Import,D,9) Do  ; Indien gewicht of statistische waarde = 0, schrappen uit de lijst
 .Set AardTra=$P(Import,D,5),StatWaa=$P(Import,D,9)
 .If AardTra=11 Set TotImpFa=TotImpFa+StatWaa
 .Else  Set TotImpFa=TotImpFa-StatWaa
 .Set Import=""
 If Import="",ImpKey'="" Set ImpKey=$O(^HULP($J,19,ImpKey)) Goto C1
C2 Set Export="" If ExpKey'="" Set Export=^HULP($J,29,ExpKey)
 If $P(Export,D,7) Set $P(Export,D,7)=$P(Export,D,7)*10+.99999\1/10
 If Count If '$P(Export,D,7)!'$P(Export,D,9) Do  ; Indien gewicht of statistische waarde = 0, schrappen uit de lijst
 .Set AardTra=$P(Export,D,5),StatWaa=$P(Export,D,9)
 .If AardTra=11 Set TotExpFa=TotExpFa+StatWaa
 .Else  Set TotExpFa=TotExpFa-StatWaa
 .Set Export=""
 If Export="",ExpKey'="" Set ExpKey=$O(^HULP($J,29,ExpKey)) Goto C2
 Set $P(Import,D,10)=$P(Import,D,10)
 Set $P(Export,D,10)=$P(Export,D,10)
 Set Count=Count+1,^INTRAST("TRANS",Count)=$P(Import,D,1,10)_D_$P(Export,D,1,10)
 If ImpKey'="" Set AantImpL=AantImpL+1,ImpKey=$O(^HULP($J,19,ImpKey))
 If ExpKey'="" Set AantExpL=AantExpL+1,ExpKey=$O(^HULP($J,29,ExpKey))
 If ImpKey="",ExpKey="" Do  Quit
 .Set ^INTRAST("TRANS",0)=DT_"\("_Maand_")"
 .Set R=^INTRAST("TRANS",1)
 .Set $P(R,D,3)=AantImpL-1
 .Set $P(R,D,4)=$P(R,D,4)-TotImpFa
 .Set $P(R,D,13)=AantExpL-1
 .Set $P(R,D,14)=$P(R,D,14)-TotExpFa
 .Set ^INTRAST("TRANS",1)=R
 Goto C1
 ;
NIGHT 
 New MailId
 Quit:+$ZDATE($H,3)'=3
 Do VERWERK()
 Set MailId=$$SYSTEM^vhMAIL("","","INTRASTAT",6,"Klaarmaken intrastat","","A") ; nr Hendrik
 ;Set:+$P($ZDATE($H,3),"/",2)#3=1 MailId=$$SYSTEM^vhMAIL("","","STATISTIEKEN",17,"Klaarmaken verkoop en aankoop statistieken","","A")
 Quit
 
 ; Bereken van de intrastat gegevens
VERWERK(Maand) 
 Lock ^INTRAST("TRANS"):1 Else  Quit
 Do PRIO^vhINITML("L")
 Set:'$D(Maand) Maand=$$CALCDATE^vhLib.DataTypes($H,"M",-1)
 Set Maand=$$EXTDATE^vhLib.DataTypes(Maand,"J4")_"."_$E(100+$$EXTDATE^vhLib.DataTypes(Maand,"MN"),2,3)
 Set ^HULP($J)=Maand
 Set Q="K" d ^cA604 ; alles wordt geNEWed
 Set Maand=^HULP($J)
 Set Dev=0 ;$$OPEN^vhDEV("\\notes01\Shared\P V","TESTINTRASTAT"_Maand_".TXT","W","T") Use Dev
 ;Write "t	l1	l2	x1	x2	x3	prnr	kt	gew	fakt	stat	netto	ppl	qty	e1	el	korttekst	levnr	Levnm",!
 
 Kill ^INTRAST("TRANS"),^HULP($J)
 Set (TotFaktA,TotFaktV)=0
 Do IMPORT
 Do EXPORT
 Do CLOSE^vhDEV(Dev)
 If 'TotFaktA,'TotFaktV Quit
 Set ^HULP($J,19,0)="IMPORT\01-"_$E(Maand,6,7)_"-"_$E(Maand,3,4)_D_D_TotFaktA
 Set ^HULP($J,29,0)="EXPORT\01-"_$E(Maand,6,7)_"-"_$E(Maand,3,4)_D_D_TotFaktV
 Do COPYTR
 Kill ^HULP($J)
 Quit
 ;
 ; Initialisatie
INIT(K) 
 Set K=K_" "_$P($T(+1),";",2)_QN_" ",FP=203+$L(K) Write @F11,@F1,@F,@F5
 Set FP=202 Write @F,@F4,K,@F5
 Lock ^INTRAST("TRANS"):2 Else  Set FP=2403 Write @F,@F2,@F4,"TRANSFERTBESTAND IN GEBRUIK  [] = ok ",@F5,@F0 Read K
 Quit
 ;
 ; Opvragen van de maand
MAAND() 
 New Maand
 Set Maand=$TR($$EXTDATE^vhLib.DataTypes($$CALCDATE^vhLib.DataTypes($h,"M",-1),"DM4"),"-",".")
 Set R="K\23\3\GEEF DE MAAND WAARVOOR DE STATISTIEK DIENT OPGEMAAKT\""onder de vorm jjjj.mm  [] = "
 SET R=R_Maand_"""\7\\K?4N1"".""2N&(K#1)&(K'>(DJ_"".""_DM))!(""-""[K)" Do R0^cA100
 If K="" S K=Maand,FP=2358 W @F,@F1,K
 Quit $$INTDATE^vhLib.DataTypes(K,"DM")
 ;
STARTJOB(Test) 
 Set FP=2403 W @F,@F2,@F4
 If Test Write "DE VOORBEREIDING VOOR TRANSFERT IS GESTART  [] = ok "
 Else  Write "DE VOORBEREIDING VOOR TRANSFERT KAN NIET GESTART WORDEN  [] = ok "
 Write @F5,@F0 Read K
 Quit
 ;
 ; Hoofdprocedure
BEGIN Do INIT("VOORBEREIDEN") Quit:'$T
B1 Set Maand=$$MAAND() Quit:Maand="-"
 Lock
 Job VERWERK^INTRAST(Maand)::2
 Do STARTJOB($T)
END Quit
 ;
 ; Transfert van de voorbereide gegevens
TRANS 
 Do INIT("TRANSFERT") Quit:'$T
 If '$D(^INTRAST("TRANS")) Do  Goto BEGIN
 .Set FP=2403
 .Write @F,@FMTI," Gelieve eerst de transfert voor te bereiden ",@FMTi,@F0
 .Do IK^PROC
 Set MainRec=$TR(^INTRAST("TRANS",0),"()",""),FP=1703
 Write @F,"Aangifte voor "
 Write @FMTB,$$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes($P(MainRec,D,2),"DM"),"MC")
 Write " ",$$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes($P(MainRec,D,2),"DM"),"J4"),@FMTb
 Write ", opgemaakt op ",@FMTB,$P(MainRec,D),@FMTb
 Set Output=$$OUTPUT() Quit:Output="-"
 Set %J=$$%J^vhRtn1()
 Do BLDHULP(Output)
 Do INIT^PROC($S(Output="O":"INTRASTOLD",1:"INTRASTNEW"),"LD")
 For I=3:1:11,13 Kill LD(I)
 Do ^OUTPUT("T","","",$$FILENM(Output,$P(MainRec,D,2)))
 If Output="B" Do
 .For I=3:1:11,13 Kill LD(I)
 .Set Output="E" Do BLDHULP(Output),^OUTPUT("T","","",$$FILENM(Output,$P(MainRec,D,2)))
 Kill ^HULP(%J)
 Lock
 Quit
 ;
 ;
 ;Land bestemming     
 ;Land herkomst       
 ;Vervoer             
 ;Haven               
 ;Aard transaktie A   
 ;Aard transaktie B   
 ;GN8 kode            
 ;Gewicht             
 ;Aanvullende eenheden
 ;Statistische waarde 
 ;Faktuurwaarde       
 ;Gewest              
 ;Leveringsvoorwaarde 
 
FILENM(Output,Datum) 
 New Maand,Jaar
 Set Maand=$$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes(Datum,"DM"),"MN")
 Set Jaar=$$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes(Datum,"DM"),"J4")
 Quit Jaar_Maand_$S(Output="E":"D",1:"A")_".txt"
 
 ; Type transfert
OUTPUT() 
 Xecute FUP
 Set R="K\23\3\OUTPUT\""I[] = import   E[] = export   B[] = beide ""\1\\""-IEB""[K&$L(K)"
 Do R0^cA100
 Xecute FLO
 Quit K
 ;
 ; Opbouwen van ^HULP
BLDHULP(Output) 
 New Count,Next,Piece,StatStel
 Kill ^HULP(%J)
 Set StatStel=$S(Output="O":"",Output="E":"29\",1:"19\")
 Set Piece=$S(Output="O":"1,20",Output="E":"11,20",1:"1,10")
 Set Count=0,Next=$S(Output="O":0,1:1)
 For  Set Next=$O(^INTRAST("TRANS",Next)) Quit:Next=""  Do
 .Set R=^INTRAST("TRANS",Next)
 .Xecute "Set R=$P(R,D,"_Piece_")"
 .Quit:$TR(R,D,"")=""
 .Set Count=Count+1,^HULP(%J,Count)=R
 Quit
 ;