BLCSBL3 G BEGIN ;Afdrukken van een geimporteerd maar niet geconverteerd CSB (DO&SO) bericht [ 11/05/2001  2:19 PM ]
TShip ;@1;C;L;6;; | \2;C;L;7;; | \3;C;N+;7
TAdr ;@1;C;L;120
TColli ;@SICOLA;C;L;13;; : \SICOLZ;N0+;R;7
TGewicht ;@"Gewicht Bruto";C;L;13;; : \BRUTO;N0+;R;7;; , \"Netto";C;L;5;; : \NETTO;N0+;R;7;;
TLijn ;@5;C;L;12;; | \3;N+;L;7;; | \PrdId;C;L;11;; | \PrdNm;C;L;25;; | \13;C;R;1;; | \12;N;R;8;;| \
TPak ;@"";N+;L;86;; |\Pak;N+;R;6;; |\QTY;N+;R;8;; | \Lab;C;L;12
TSep ;@-----------------------------------------------------------------------------------------------------------------------------------
THead ;@"Toelevering";C;C;12;; | \"AB";C;C;7;; | \"IdentNr";C;C;11;; | \"Korttekst";C;C;25;; |\"C/P";C;R;3;;| \"Aantal";C;R;8;;| \
BEGIN ; 
C1 X F71 Set:'$D(MsgId) MsgId=1 ; Tijdelijk voor testen
 Goto YZ:'$D(^BLImp(MsgId,1))
 Do INIT^vhPRINTER("B",132,"P") Goto YZ:'$D(Print)
 Kill ^HULP($J+100),^HULP($J+200),HD
 Set RecNr=-1
L2 Do NextRec Goto List:RecNr=-1
 G L2:RecType'=11
 Do CShip
L3 Do NextRec Goto List:RecNr=-1
 G L3:RecType'=21
Ship Do VShip
L4 Do NextRec Goto List:RecNr=-1
 Do VCom:$E(RecType,2)=9,VAdr:RecType=22
 Goto Ship:RecType="21",L4:RecType'=41
 Do PShip
Lijn Do VLijn 
L5 Do NextRec Goto List:RecNr=-1
 Do VCom:$E(RecType,2)=9,VProd:RecType=42,VPack:RecType=44
 Goto Ship:RecType=21,Lijn:RecType=41,L5
CShip Set RecNaam="CSB-SO-11" Do TF
 Set ConsRec=NewRec
 Q
VShip Set RecNaam="CSB-SO-21" Do TF
 Set ShipRec=NewRec,AdrRec=""
 Q
VAdr Set RecNaam="CSB-SO-22" Do TF
 Set AdrRec=NewRec
 Q
PShip If $D(HD) Do List,Footer
 If $D(^BLBeri("K",$P(ShipRec,D,4))) Set HD(1)="Vervoerlijst : "_$P(^($P(ShipRec,D,4)),D,1)
 Else  Set HD(1)="Vervoerlijst : Onbekend "_$P(ShipRec,D,4)
 Set HD(2)=$P($G(ConsRec),D,1)
 Do Header^BLKALL2
 ;Set FL(1)=$P($T(TBon),"@",2),FL(2)=0,FL(3)=ShipRec Do FL^PROC
 Write !,!,$P($T(TSep),"@",2)
 If AdrRec'="" Set FL(1)=$P($T(TAdr),"@",2),FL(2)=0,FL(3)=AdrRec Write ! Do FL^PROC
 Set LijnPr=12,I=1,Tekst="Colli",FL(1)=$P($T(TColli),"@",2),FL="0"
PS1 Goto PS2:'$P(ShipRec,D,I*2+7)
 Set P=$P(ShipRec,D,I*2+6),SICOLZ=$P(ShipRec,D,I*2+7),SICOLA=$S(P="P":"Pakket",P="E":"Euro-palett",P="B":"Blum-palett",P="S":"Zak",1:"Onbekend")
 Write ! Do FL^PROC Set Tekst="",LijnPr=LijnPr+1
PS2 If I<5 Set I=I+1 Goto PS1
 Set BRUTO=$P(ShipRec,"\",5),NETTO=$P(ShipRec,"\",6)
 Set FL(1)=$P($T(TGewicht),"@",2),FL(2)=0,FL(3)=ShipRec Write ! Do FL^PROC
 Write !,$P($T(TSep),"@",2)
 Set FL(1)=$P($T(THead),"@",2),FL(2)=0,FL(3)=ShipRec Write ! Do FL^PROC
 Write !,$P($T(TSep),"@",2)
 Q
VLijn Set RecNaam="CSB-SO-41" Do TF
 Quit:$P(NewRec,"\",9)="P"  ;SISETK="Partial"
 Set (^HULP($J+100,ABNr,ABLNr,41),Lijn)=NewRec
 Q
VProd Quit  ;Set RecNaam="CSB-SO-42" Do TF
 Set ^HULP($J+100,ABNr,ABLNr,42)=NewRec
 Q
VPack Quit  ;Set RecNaam="CSB-SO-44" Do TF B
 If $D(^HULP($J+100,ABNr,ABLNr,44)) Set PackRec=^(44)
 Else  Set PackRec=""
 FOR I=1:3:14 Set:$P(NewRec,D,I+1)!$P(NewRec,D,I+2) Pack=$P(NewRec,D,I)_D_$P(NewRec,D,I+1)_D_$P(NewRec,D,I+2),PackRec=PackRec_Pack_D,^HULP($J+200,$P(NewRec,D,I)_D_ABNr_D_ABLNr)=Lijn_D_Pack
 Set:PackRec'="" ^HULP($J+100,ABNr,ABLNr,44)=PackRec
 Q
List Set (OldABNr,ABNr)=-1
Li1 Set ABNr=$N(^HULP($J+100,ABNr)) Goto YZ:ABNr=-1
 Set ABLNr=-1
Li2 Set ABLNr=$N(^HULP($J+100,ABNr,ABLNr)) Goto Li1:ABLNr=-1
 Do PLijn
 Goto Li2
PLijn If '$D(^HULP($J+100,ABNr,ABLNr,41)) Q
 Set LijnRec=^(41),(ProdRec,PackRec)=""
 Goto PL1:OldABNr=ABNr
 Set ToeNr=$P(LijnRec,D,5)
 Set OldABNr=ABNr Goto PL2
PL1 Set $P(LijnRec,D,3)="",ToeNr=""
PL2 If LijnPr>(Print("LEN")-$S(ToeNr="":1,1:2)-($L(PackRec,D)\3)) Do
 .Do Footer,Header^BLKALL2 Set LijnPr=6
 .Set FL(1)=$P($T(THead),"@",2),FL(2)=0,FL(3)=ShipRec Write ! Do FL^PROC
 .Write !,$P($T(TSep),"@",2)
 Set PrdId=$P(LijnRec,D,8)_" ",(PrdNm,PrdNr)="" Set:$L(PrdId)=8 PrdId=0_PrdId
 If PrdId'="",$D(^KPR2(PrdId)) Set PrdNr=$P(^(PrdId),D,1)
 If PrdNr="",$D(^BLProd("D",$E(PrdId,1,8))) Set PrdNm=$P(^($E(PrdId,1,8)),D,1)
 Else  If 'PrdNr Set PrdNm="*** Onbekend ***"
 Else  Set PrdNm=$P(^KPR(PrdNr,0),D,1)
 Set PrdId=$E(PrdId,1)_"."_$E(PrdId,2,4)_"."_$E(PrdId,5,7)_"."_$E(PrdId,8)
 Set FL(1)=$P($T(TLijn),"@",2),FL(2)="0",FL(3)=LijnRec,I=1
PL3 Set Lab=$P(PackRec,D,I),Pak=$P(PackRec,D,I+1),QTY=$P(PackRec,D,I+2)
 Write ! Do FL^PROC
 Set FL(1)=$P($T(TPak),"@",2),I=I+3,LijnPr=LijnPr+1 Goto PL3:$P(PackRec,D,I+1)!$P(PackRec,D,I+2)
 Q
VCom Q
Footer Write # Q
NextRec Set RecNr=$N(^BLImp(MsgId,RecNr)) Q:RecNr=-1  
 Set RecInp=^(RecNr),RecType=$E(RecInp,2,3) Q
StrNum Set NUM="",SN1=1
SN1 Set:+$E(STR,SN1)!($E(STR,SN1)=0) NUM=NUM_$E(STR,SN1) Set SN1=SN1+1 Goto SN1:SN1'>$L(STR)
 Q
 
TF SET Tptr=0,Tptr=$N(^BLRecDef(RecNaam,Tptr)),NewRec=""
TLoop Q:Tptr=-1
 Set TRec=^(Tptr),Piece=$P(TRec,D,4),Local=$P(TRec,D,5),Type=$P(TRec,D,6)
 If 'Piece&(Local="") Set Tptr=$N(^(Tptr)) Goto TLoop
 Set TF1=$E(RecInp,$P(TRec,D,1),$P(TRec,D,2))
LTRIM If $E(TF1,1)=" " Set TF1=$E(TF1,2,999) Goto LTRIM
RTRIM If $E(TF1,$L(TF1))=" " Set TF1=$E(TF1,1,$L(TF1)-1) Goto RTRIM
 Set:Type="N" TF1=+TF1
 Set:Type="D" TF1=$E(TF1,5,6)_"."_$E(TF1,3,4)_"."_$E(TF1,1,2)
 If Type="W" Do
 .Set TF1=$E(TF1,5,6)_"."_$E(TF1,3,4)_"."_$E(TF1,1,2)
 .Set TF1=$$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes(TF1),"DW")
 Set:Piece $P(NewRec,D,Piece)=TF1
 Set:Local'="" @Local=TF1
 Set Tptr=$N(^(Tptr)) Goto TLoop
YZ ;Do Footer:$D(^HULP($J+100))
 W # Do CLOSE^vhPRINTER
 Set FP=2301 Write @F,@F1
 Kill ^HULP($J+100),^HULP($J+200)
 Q