DCSPO ;AFDRUKKEN SPOORDOCUMENTEN [ 01/17/2002   4:06 PM ]
 ;
VERWERK(FromNr,Sessie) 
 New FANr
 Do INIT,CUMUL
 Set FANr=$S(FromNr:FromNr-1,1:FromNr)
 For  Set FANr=$O(^HULP($J,"EXTRAS","S",FANr)) Quit:FANr=""  Do PRINT(FANr,Sessie,1)
 Quit
 ;
CACHE(R) 
 Do CACHE^DCALG(R)
 Quit
 ;
PASTE(Page,Line,Text,BPos,EPos,Attr) 
 Do PASTE^DCALG(Page,Line,Text,BPos,EPos,Attr)
 Quit
 ;
 ; Afdruk body
BODY 
 New B,R,BCount,BonInd
 New KlantInd,Blank,Aanspr,Naam,Toenaam,Straat,PostNr,Woonpl,Taal,BtwNr,Telefoon
 New Palet,Colli,Karton,Gewicht,BonInd,FakNrs
 Set PCount=PCount+1,LCount=0
 Set KlantInd=^KK1(KLNr),R=^KKL(KlantInd,0)
 Set Telefoon=$P(R,D,13),BtwNr=$$BTWNR^DCALG($P(R,D,16))
 Set BonInd="U",BonInd=$O(@("^KFA"_Proforma_"(""F"",FANr,BonInd)"))
 If BonInd'="",+$G(@("^KFA"_Proforma_"(""F"",FANr,BonInd,3)")) Set R=@("^KFA"_Proforma_"(""F"",FANr,BonInd,3)")
 Set Naam=$P(R,D,2),Toenaam=$P(R,D,3),Aanspr=$P(R,D,4)
 Set Straat=$P(R,D,5),PostNr=$P(R,D,6),Woonpl=$P(R,D,7)
 Set Taal=$P(R,D,9) If Taal="" Set Taal="N"
 If $L($P(R,D,13)) Set Telefoon=$P(R,D,13)
 Set R=^HULP($J,"EXTRAS","S",FANr),Palet=$P(R,D,2),Colli=$P(R,D,3),Karton=$P(R,D,4)
 Set Gewicht=$J($P(R,D,5),0,1) Set:'(Gewicht#1) Gewicht=Gewicht\1
 Set FakNrs=$P(R,D,6,99)
 If Sessie="D" Do
 .For Blank=1:1:MaxLines Do CACHE("")
 .Do PASTE(PCount,Blank-28,$TR($FN(FANr,","),",","."),65,"","B")
 .Set T=$$FIRMANM^DCALG("K",KLNr)
 .If KLNr=8545,$L(T),$L(Toenaam) Set R=T,T=Toenaam,Toenaam=R
 .If $L(Toenaam) Do
 ..Do PASTE(PCount,Blank-25,$E(T,1,25),12,"","")
 ..Do PASTE(PCount,Blank-24,$E(Toenaam,1,25),12,"","")
 .If '$L(Toenaam) Do PASTE(PCount,Blank-24,$E(T,1,25),12,"","")
 .Do PASTE(PCount,Blank-23,$E(Straat,1,25),12,"","")
 .Do PASTE(PCount,Blank-22,$E(PostNr,1,25),12,"","")
 .Do PASTE(PCount,Blank-21,$E(Woonpl,1,25),12,"","")
 .Do PASTE(PCount,Blank-20,$E(Telefoon,1,12),9,"","")
 .Do PASTE(PCount,Blank-20,$E(BtwNr,1,14),24,"","")
 .Do PASTE(PCount,Blank-24,VH(1),58,"","")
 .Do PASTE(PCount,Blank-23,VH(2),58,"","")
 .Set T=$$TRIMN^vhRtn1(VH(3))
 .Do PASTE(PCount,Blank-22,T,58,"","")
 .Set T=$TR($P(VH(3)," ",2,99)," ","")
 .Do PASTE(PCount,Blank-21,T,58,"","")
 .Set T=$TR($P(VH(4),":",2)," ","")
 .Do PASTE(PCount,Blank-20,T,55,"","")
 .Set T=$P($P(VH(6),":",2)," ",2,9)
 .Do PASTE(PCount,Blank-20,T,70,"","")
 .Do PASTE(PCount,Blank-18,159,81,"","")
 .Do PASTE(PCount,Blank-17,ContrNr,52,"","")
 .Do PASTE(PCount,Blank-17,AfzendNr,63,"","")
 .Set T=Karton+Colli+Palet
 .If T Do
 ..For I=$L(T):-1:2 Set $E(T,I)=" "_$E(T,I)
 ..Do PASTE(PCount,Blank-14,T,"",57,"")
 .If Gewicht Do
 ..Set T=$TR(Gewicht,".",",")
 ..For I=$L(T):-1:2 Set $E(T,I)=" "_$E(T,I)
 ..Do PASTE(PCount,Blank-14,T,"",67,"")
 .Set T=$$TXT("AardGd") Do PASTE(PCount,Blank-11,T,12,"","")
 .Do PASTE(PCount,Blank,"XXXXXXXXX",71,"","")
 .If $L(FakNrs) For I=2:1:$L(FakNrs,D) Do PASTE(PCount,Blank-28+I,$P(FakNrs,D,I),41,"","")
 If Sessie="E" Do
 .For Blank=1:1:MaxLines Do CACHE("")
 .Do PASTE(PCount,Blank-12,VH(1),10,"","")
 .Do PASTE(PCount,Blank-12,$TR($FN(FANr,","),",","."),47,"","B")
 .Do PASTE(PCount,Blank-11,VH(2),10,"","")
 .Set T=$$TRIMN^vhRtn1(VH(3))
 .Do PASTE(PCount,Blank-9,T,10,"","")
 .Set T=$TR($P(VH(3)," ",2,99)," ","")
 .Do PASTE(PCount,Blank-9,T,22,"","")
 .Set T=Karton+Colli+Palet
 .If T Do PASTE(PCount,Blank-8,T,53,"","")
 .Set T="" If $L(Aanspr) Set T=Aanspr_" "
 .Set T=T_Naam
 .If $L(Toenaam) Do
 ..Do PASTE(PCount,Blank-4,T,10,"","")
 ..Do PASTE(PCount,Blank-3,Toenaam,10,"","")
 .If '$L(Toenaam) Do PASTE(PCount,Blank-3,T,10,"","")
 .Do PASTE(PCount,Blank-2,Straat,10,"","")
 .Do PASTE(PCount,Blank,PostNr_"   "_Woonpl,10,"","")
 Quit
 ;
ABX 
 New R,FANr
 Do ADD^vhLock("^abx")
 Kill ^abx
 Set FANr=""
 For  Set FANr=$O(^HULP($J,"EXTRAS","S",FANr)) Quit:FANr=""  Do
 .Quit:$P(^HULP($J,"EXTRAS","S",FANr),D,2,99)=""
 .Set R=^HULP($J,"EXTRAS","S",FANr),^abx(FANr)=R
 Do REMOVE^vhLock("^abx")
 Quit
 ;
CLEAN 
 New FANr,Proforma
 Set FANr=""
 For  Set FANr=$O(^HULP($J,"EXTRAS","S",FANr)) Quit:FANr=""  Do
 .If $P(^HULP($J,"EXTRAS","S",FANr),D,2,99)="" Kill ^HULP($J,"EXTRAS","S",FANr) Quit
 .Set Proforma=$P(^HULP($J,"T",FANr),D,2)
 .;If $$FAKSPOOR("")<2 Kill ^HULP($J,"EXTRAS","S",FANr)
 Quit
 ;
 ; Kontrole faktuur voor spoor
FAKSPOOR(Sessie) 
 New R,Palet,Colli,Karton,Gewicht
 Set R=^HULP($J,"EXTRAS","S",FANr),Palet=$P(R,D,2),Colli=$P(R,D,3)
 Set Karton=$P(R,D,4),Gewicht=$J($P(R,D,5),0,1) Set:'(Gewicht#1) Gewicht=Gewicht\1
 If 'Palet,'Colli,'Karton,'Gewicht Quit 0
 If Sessie="D" Quit 0
 If Sessie="E" Quit Palet+Colli+Karton
 Quit Palet+Colli+Karton
 ;
 ; Opbouwen local C en afdrukken van de faktuur
PRINT(FANr,Sessie,Init) 
 New KLNr,KlantInd,AantSets,Proforma
 New C,PCount,LCount
 If '$G(Init) Do INIT
 Quit:$P(^HULP($J,"EXTRAS","S",FANr),D,2,99)=""
 Set Proforma=$P(^HULP($J,"T",FANr),D,2)
 Set PCount=0
 Set R=@("^KFA"_Proforma_"(""F"",FANr,0,0)"),KLNr=$P(R,D)
 Set AantSets=$$FAKSPOOR(Sessie) Quit:'AantSets
 Do BODY
 For I=1:1:AantSets Do DPRINT^DCPRINT()
 Quit
 ;
 ; Initialisatie
INIT 
 If '$D(VH) Do VH^DCINIT
 If '$D(P) Do PINIT^DCINIT
 Set R=^KBA(176),ContrNr=$P(R,D,2),AfzendNr=$P(R,D,3)
 Set PageLen=$S(Sessie="D":36,1:18),MaxLines=PageLen-$S(Sessie="D":6,1:5),V=1
 Set FP=PageLen Write @F32
 Write P("D",0)
 Quit
 ;
 ; Ophalen taalafhankelijke tekst
TXT(Ref,Piece) 
 If '$D(Piece) Set Piece=2
 Quit $P($P($T(@("T"_Ref)),U,Piece),D,$F("NFDE",Taal)-1)
 ;
CUMUL   
 New R,Proforma,FANr,KLNr,Palet,Colli,Karton,Gewicht,Ref
 Quit:$G(^HULP($J,"EXTRAS","S"))
 Set FANr=""
 For  Set FANr=$O(^HULP($J,"EXTRAS","S",FANr)) Quit:FANr=""  Do
 .Set Proforma=$P(^HULP($J,"T",FANr),D,2)
 .Set R=$O(@("^KFA"_Proforma_"(""F"",FANr,""U"")")),LevAdr=0 S:$E(R)="U" LevAdr=$P(^(R,3),D,1,8)
 .Set KLNr=^HULP($J,"EXTRAS","S",FANr),Ref="^HULP($J,""EXTRAS"",""S"","_FANr_")"
 .Set:$D(KLNr(KLNr,LevAdr)) Ref="^HULP($J,""EXTRAS"",""S"","_KLNr(KLNr,LevAdr)_")"
 .Set R=@("^KFA"_Proforma_"(""F"",FANr,0,3)"),Palet=$P($P(R,D,21),"#"),Colli=$P($P(R,D,21),"#",2)
 .Set Karton=$P($P(R,D,21),"#",3),Gewicht=$P(R,D,22)
 .Set R=@Ref,$P(R,D,2)=$P(R,D,2)+Palet,$P(R,D,3)=$P(R,D,3)+Colli
 .Set $P(R,D,4)=$P(R,D,4)+Karton,$P(R,D,5)=$P(R,D,5)+Gewicht,@Ref=R_D_FANr
 .Set:'$D(KLNr(KLNr,LevAdr)) KLNr(KLNr,LevAdr)=FANr
 Set ^HULP($J,"EXTRAS","S")=1
 Quit
 ;
TAardGd ;Meubelbeslag\Quincaillerie pour meubles\Meubelbeslag\Meubelbeslag