PVBLUMST ;Blum statistiek [ 11/08/2003   8:42 PM ]
 ; Orderlijnen detail en receptie detail
 Q
 
BONFETCH(%J,BeginDat,EndDat) ;Verwerken bonlijnen en overbrengen naar tijdelijkbestand
 Kill ^HULP(%J,"D"),^HULP(%J,"LA")
 Set LevAdrCnt=0
 s Dat=-$H,Vrzw=""
 Do BLDCONTR^KPOSW
 f  s Dat=$O(^KU3(Dat)) Quit:Dat=""  f  S Vrzw=$O(^KU3(Dat,Vrzw)) Quit:Vrzw=""  Do 
 .Quit:(-Dat)<BeginDat
 .Quit:(-Dat)>EndDat
 .s BONNr=""
 .f  s BONNr=$O(^KU3(Dat,Vrzw,BONNr)) Quit:BONNr=""  Do
 ..Set KLNr=$P(^KU3(Dat,Vrzw,BONNr),D)
 ..Set KLId=$G(^KK1(KLNr),"*")
 ..Set Regio=$P($G(^KKL(KLId,0)),D,20)
 ..Set Aktiv=$P($G(^KKL(KLId,1)),D,11)
 ..Set KlantType=$P($G(^KKL(KLId,1)),D,25)
 ..Set Codex=$P($G(^KKL(KLId,2)),D,3)_$S($D(^KLPUTZ("N",KLNr)):"+",1:"")
 ..Set Node=$P(^KU3(Dat,Vrzw,BONNr),D,2)
 ..Set Lijn=90
 ..Set BONDat=$TR($$EXTDATE^DTyp(-Dat,"DKP"),".","/")
 ..Set BONTyp=$P(^KUL(KLNr,Node,BONNr,1),D,25)
 ..Set:BONTyp'="M"&(BONTyp'="P") BONTyp=""
 ..Set Vzw=$E(Vrzw,1,2)
 ..Set OrdCnt=0
 ..Set LevAdr="",LevRec=$G(^KUL(KLNr,Node,BONNr,3))
 ..Set:$TR(LevRec,"\","")="" LevRec=$G(^KKL(KLId,0))
 ..For I=2:1:6 Set LevAdr=LevAdr_$E($P(LevRec,D,I),1,5)
 ..Set:LevAdr="" LevAdr="*"
 ..Set LevAdrNr=$G(^HULP(%J,"LA",LevAdr,KLNr))
 ..If 'LevAdrNr Do 
 ...Set LevAdrCnt=LevAdrCnt+1
 ...Set LevAdrNr=LevAdrCnt
 ...Set ^HULP(%J,"LA",LevAdr,KLNr)=LevAdrCnt
 ..Set Land=$P(LevRec,D,8)
 ..Set:Land'="NL" Land="B"
 ..For  Set Lijn=$O(^KUL(KLNr,Node,BONNr,Lijn)) Quit:'Lijn  Do
 ...Set Rec=^KUL(KLNr,Node,BONNr,Lijn)
 ...If $P(Rec,D,17)="KF5" Do  ; Order
 ....Set OrdRef=$P(Rec,D,5)
 ....Set ORDNr=$P(OrdRef," - ",1)
 ....Set ORDDat=$TR($P(OrdRef," - ",2),".","/")
 ...Quit:'$P(Rec,D,2)&($P($P(Rec,D,17),"#")'="KF1925")  ; txtlijn
 ...Quit:$P(Rec,D,14)["Z"!($P(Rec,D,14)["S")  ; zonder stockaanpassing
 ...Set PRNr=$P(Rec,D,2)
 ...If PRNr Do
 ....If $D(^KPR(PRNr)) Do
 .....Set Rec0=^KPR(PRNr,0)
 .....Set Rec1=^KPR(PRNr,1)
 .....Set Rec2=^KPR(PRNr,2)
 .....Set RecI=$O(^KPR(PRNr,"I")),RecI=^KPR(PRNr,RecI)
 .....Set RecJ=$O(^KPR(PRNr,"J")),RecJ=^KPR(PRNr,RecJ)
 .....Set IDNr=$P(^KPR(PRNr,2),D,25)
 ....Else  If $D(^KPRO(PRNr)) Do
 .....Set Rec1=^KPRO(PRNr,1)
 .....Set Rec2=^KPRO(PRNr,2)
 .....Set Rec0=^KPRO(PRNr,0)
 .....Set RecI=$O(^KPRO(PRNr,"I")),RecI=^KPRO(PRNr,RecI)
 .....Set RecJ=$O(^KPRO(PRNr,"J")),RecJ=^KPRO(PRNr,RecJ)
 ....Else  Set PRNr=""
 ...Quit:'PRNr
 ...Set RecBL=""
 ...Set IDNr=$P(Rec2,D,25)
 ...If $P(RecJ,D,1)=5005 Do  ; Blum
 ....Set BLID="0"_$TR($E(IDNr,3,99),".","")
 ....Set RecBL=$G(^BLProd("D",$S(BLID="":"*",1:BLID)))
 ...If 'PRNr Do
 ....Set PRNr="MAN"
 ....Set KortT="Man. produkt"
 ....Set Klas="MN-MAN"
 ....Set Stock=""
 ....Set LigP=""
 ....Set Gew=""
 ....Set Verp=1
 ....Set (Stuk,Qty)=$P(Rec,D,3)
 ...Else  Do
 ....Set (Hoogte,Lengte,Breedte,BrutoGew,NettoGew,PalQty)=0
 ....Set KortT=$P(Rec0,D,1)
 ....Set NettoGew=$P(RecBL,D,26)/1000
 ....Set BrutoGew=$P(RecBL,D,9)/1000
 ....Set:'BrutoGew BrutoGew=$P(Rec1,D,13)/1000
 ....Set PalQty=$P(RecBL,D,18)
 ....Set Qty=$P(Rec,D,3)
 ....Set NettoGew=Qty*NettoGew
 ....Set BrutoGew=Qty*BrutoGew
 ....Set VD2=$P(RecBL,D,19)
 ....Set Hoogte=$P(RecBL,D,23)
 ....Set Lengte=$P(RecBL,D,24)
 ....Set Breedte=$P(RecBL,D,25)
 ....Set DefMag=$P(Rec2,D,15)
 ....Set BLVerp=$P(RecBL,D,6) Set:'BLVerp BLVerp=$P(RecJ,D,16)
 ....Set Vol=Hoogte*Lengte*Breedte*Qty/1000000/BLVerp
 ....Set LevNr=$P(RecJ,D,1)
 ....Set Klas=$P(RecI,D,2)
 ....Set Klas=$$DISPLS^KLASS(Klas)
 ....Set ABCRot=$E($P($P(Rec0,D,8),"#"))
 ....Set ABCVal=$E($P($P(Rec0,D,8),"#",2))
 ....Set Verp=""
 ....Set (GVerp,KVerp,Stuk,QtyGVerp,QtyKVerp)=0
 ....Set Stuk=Qty,Neg=$S(Stuk<0:-1,1:1)
 ....Set Stuk=Stuk*Neg
 ....If $P(RecJ,D,16) Set GVerp=Stuk\$P(RecJ,D,16),QtyGVerp=GVerp*$P(RecJ,D,16)*Neg,Stuk=Stuk#$P(RecJ,D,16) 
 ....If $P(RecJ,D,15) Set KVerp=Stuk\$P(RecJ,D,15),QtyKVerp=KVerp*$P(RecJ,D,15)*Neg,Stuk=Stuk#$P(RecJ,D,15) 
 ....Set QtyStuk=Stuk*Neg
 ....Set Stock=$P(Rec1,D,20)
 ....Set Stock=$S(Stock:"S",1:"N")
 ....Set:$D(ContrInd(PRNr)) Stock="C"
 ....Set CiffPPL=$P(RecJ,D,23)*Qty
 ....Set LevGrp=$S(LevNr=5005:"BLUM",1:"Andere")
 ...Quit:LevNr=6332  ; Halux
 ...Quit:LevNr=6092  ; FolieTec
 ...Quit:LevNr=5810  ; Burbidge
 ...Set RecHfd=BONNr_D_BONDat_D_BONTyp_D_ORDNr_D_ORDDat_D_Vzw_D_Land_D_KLNr_D_LevAdrNr_D_Regio_D_Aktiv_D_KlantType_D_Codex
 ...Set RecLijn=Klas_D_LevNr_D_PRNr_D_Qty_D_QtyGVerp_D_QtyKVerp_D_QtyStuk_D_GVerp_D_KVerp_D_Stuk_D_DefMag_D_CiffPPL_D_ABCRot_D_ABCVal_D_Stock_D_PalQty_D_BrutoGew_D_NettoGew_D_Vol
 ...;Set VolgNr=$O(^HULP(%J,"D",Dat,LevAdrNr,BONNr,ORDNr,""),-1)+1
 ...;Zw:BONTyp'="" RecHfd ;Zw RecLijn
 ...Set ^HULP(%J,"D",Dat,LevAdrNr,LevGrp,BONNr,ORDNr,Lijn)=RecHfd_D_RecLijn
 Quit
 ;
BONOVZ Set %J=$$%J^vhRtn1()
 Set BeginDat=$$INTDATE^vhDTyp("01.02.00")
 Set EndDat=$$INTDATE^vhDTyp("31.01.01")
 Do BONFETCH(%J,BeginDat,EndDat)
 Set Dev=0 
 Set Dev=$$OPEN^vhDEV(,"BONOVZ.txt","W")
 Use Dev
 Set TitelHfd="BONNr;BONDat;BONTyp;ORDNr;ORDDat;Vzw;Land;KLNr;LevAdr;Regio;Aktiv;KlantType;Codex"
 Set TitelLijn="LevGrp;LijnCnt;#GVerp;#KVerp;#LijnG;#LijnK;#LijnStuk;CiffPPL;BrutoGew;NettoGew;Vol"
 Write $TR(TitelHfd_";"_TitelLijn,";",$C(9)),!
 Set (Dat,LevAdr,VolgNr,ORDNr,BONNr,LevGrp)=""
 For  Set Dat=$O(^HULP(%J,"D",Dat)) Quit:Dat=""  Do
 .For  Set LevAdr=$O(^HULP(%J,"D",Dat,LevAdr)) Quit:LevAdr=""  Do
 ..For  Set LevGrp=$O(^HULP(%J,"D",Dat,LevAdr,LevGrp)) Quit:LevGrp=""  Do
 ...Set LijnCnt=0
 ...Set RecOvz=""
 ...For  Set BONNr=$O(^HULP(%J,"D",Dat,LevAdr,LevGrp,BONNr)) Quit:BONNr=""  Do
 ....For  Set ORDNr=$O(^HULP(%J,"D",Dat,LevAdr,LevGrp,BONNr,ORDNr)) Quit:ORDNr=""  Do
 .....For  Set VolgNr=$O(^HULP(%J,"D",Dat,LevAdr,LevGrp,BONNr,ORDNr,VolgNr)) Quit:VolgNr=""  Do
 ......Set RecHfd=$P(^HULP(%J,"D",Dat,LevAdr,LevGrp,BONNr,ORDNr,VolgNr),"\",1,13)
 ......Set RecLijn=$P(^HULP(%J,"D",Dat,LevAdr,LevGrp,BONNr,ORDNr,VolgNr),"\",14,99)
 ......Set $P(RecOvz,D,1)=$P(RecOvz,D,1)+1
 ......Set $P(RecOvz,D,2)=$P(RecOvz,D,2)+$P(RecLijn,D,8)
 ......Set $P(RecOvz,D,3)=$P(RecOvz,D,3)+$P(RecLijn,D,9)
 ......Set $P(RecOvz,D,4)=$P(RecOvz,D,4)+$S($P(RecLijn,D,8):1,1:0)
 ......Set $P(RecOvz,D,5)=$P(RecOvz,D,5)+$S($P(RecLijn,D,9):1,1:0)
 ......Set $P(RecOvz,D,6)=$P(RecOvz,D,6)+$S($P(RecLijn,D,10):1,1:0)
 ......Set $P(RecOvz,D,7)=$P(RecOvz,D,7)+$P(RecLijn,D,12)
 ......Set $P(RecOvz,D,8)=$P(RecOvz,D,8)+$P(RecLijn,D,17)
 ......Set $P(RecOvz,D,9)=$P(RecOvz,D,9)+$P(RecLijn,D,18)
 ......Set $P(RecOvz,D,10)=$P(RecOvz,D,10)+$P(RecLijn,D,19)
 ...For I=1:1:13 Write:I>1 $C(9) Write $P(RecHfd,D,I)
 ...Write $C(9),LevGrp
 ...For I=1:1:10 Write $C(9),$TR($P(RecOvz,D,I),".",",")
 ...Write !
 Close:0'[Dev Dev 
 Kill ^cHULP(%J)
 Quit
 
BONDTL S %J=$$%J^vhRtn1()
 Set BeginDat=$$INTDATE^vhDTyp("01.11.00")
 Set EndDat=$$INTDATE^vhDTyp("31.01.01")
 Do BONFETCH(%J,BeginDat,EndDat)
 Set Dev=0 
 Set Dev=$$OPEN^vhDEV(,"BONDTL.txt","W")
 Use Dev
 Set TitelHfd="BONNr;BONDat;BONTyp;ORDNr;ORDDat;Vzw;Land;KLNr;LevAdr;Regio;Aktiv;KlantType;Codex"
 Set TitelLijn="Klas;LevNr;PRNr;Qty;QtyGVerp;QtyKVerp;QtyStuk;GVerp;KVerp;Stuk;DefMag;CiffPPL;ABCRot;ABCVal;Stock;PalQty;BrutoGew;NettoGew;Vol"
 Write $TR(TitelHfd_";"_TitelLijn,";",$C(9)),!
 
 Set (Dat,LevAdr,VolgNr,BONNr,ORDNr,LevGrp)=""
 For  Set Dat=$O(^HULP(%J,"D",Dat)) Quit:Dat=""  Do
 .For  Set LevAdr=$O(^HULP(%J,"D",Dat,LevAdr)) Quit:LevAdr=""  Do
 ..For  Set BONNr=$O(^HULP(%J,"D",Dat,LevAdr,BONNr)) Quit:BONNr=""  Do
 ...For  Set ORDNr=$O(^HULP(%J,"D",Dat,LevAdr,BONNr,ORDNr)) Quit:ORDNr=""  Do
 ....For  Set LevGrp=$O(^HULP(%J,"D",Dat,LevAdr,BONNr,ORDNr,LevGrp)) Quit:LevGrp=""  Do
 .....For  Set VolgNr=$O(^HULP(%J,"D",Dat,LevAdr,BONNr,ORDNr,LevGrp,VolgNr)) Quit:VolgNr=""  Do
 ......Set Rec=^HULP(%J,"D",Dat,LevAdr,BONNr,ORDNr,LevGrp,VolgNr)
 ......For I=1:1:13 Write:I>1 $C(9) Write $P(Rec,D,I)
 ......For I=14:1:32 Write $C(9),$TR($P(Rec,D,I),".",",")
 ......Write !
 
 Close:0'[Dev Dev 
 Kill ^cHULP(%J)
 Quit