BLKALL3 G BEGIN ;Afdrukken van het geimporteerd maar noch niet geconverteerde COA (SO&DO bericht) [ 11/04/96  2:41 PM ]
 
ONE(KLantNr) ; Beperkt tot een klant
 New KlantLim
 Set KlantLim=KlantNr
 
 
BEGIN ; 
 ;s KlantLim="044260"
C1 ; Vergelijken BLUMBestand
 ;Set MsgId=1 ; Tijdelijk voor testen
 Set LevNr=$P(^BLImp(MsgId),D,2)
 Set FP=2301 Write @F,@F1,"Converteren van de BLUM record struktuur"
 ;Set RecNaam="MSGB",RecInp=^BLImp(MsgId) Do TF
 Kill ^HULP($J+100)
 Set RecNr=-1,DummyBon="500000"
L3 Do NextRec Goto List:RecNr=-1
 G L3:RecType'="11"
BON Set RecNaam="COA-SO-11",ComNr=1,DummyLijn=500,(Status,Test)="" Do TF,VwBON
L4 Do NextRec Goto List:RecNr=-1
 Goto BON:RecType="11" Do VwComB:RecType="19" 
 Goto L4:RecType'="22"
LIJN Set RecNaam="COA-SO-22",ComNr=1,(Status,Test)="" Do TF,VwLIJN
L5 Do NextRec Goto List:RecNr=-1
 Goto BON:RecType="11" Do VwComL:RecType="29" 
 Goto LIJN:RecType="22",L5
VwBON Set:+ABNr'?6N (DummyBon,ABNr)=DummyBon+1
 Set ^HULP($J+100,"P",KlantNr,ABNr)=NewRec,DummyLijn=100000
 Q
VwLIJN Set:+ABLNr'?4N.N (DummyLijn,ABLNr)=DummyLijn+1
 Set ^HULP($J+100,"P",KlantNr,ABNr,ABLNr)=NewRec_D_COPRIC_D_COPRDI_D_COLTA
 Q
VwComL Q
VwComB Q
 
List    
 Set (KlantNr,ABNr,ABLNr)="",Cnt=0
 For  Set KlantNr=$O(^HULP($J+100,"P",KlantNr)) Quit:'KlantNr  Do
 .;Nakijken of beperkt tot 1 bepaalde klant
 .If $D(KlantLim),KlantLim'=KlantNr Kill ^HULP($J+100,"P",KlantNr) Quit
 .Set KlantRef=KlantNr
 .For  Set ABNr=$O(^HULP($J+100,"P",KlantNr,ABNr)) Quit:'ABNr  Do
 ..Set Rec=^HULP($J+100,"P",KlantNr,ABNr)
 ..Set ToeRef=$P(Rec,D,4),ABRef=$P(Rec,D,5)
 ..For  Set ABLNr=$O(^HULP($J+100,"P",KlantNr,ABNr,ABLNr)) Quit:'ABLNr  Do
 ...Set Rec=^(ABLNr)
 ...Set $P(Rec,D,20)=ABRef
 ...Set $P(Rec,D,21)=ToeRef
 ...Set $P(Rec,D,22)=KlantRef
 ...Set PrdId=$P(Rec,D,7)_" ",(PrdNm,PrdNr)="" Set:$L(PrdId)=8 PrdId=0_PrdId
 ...Set BLID=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)_$S($P(^KPR(PrdNr,1),D,20):"",1:"*")
 ...Set PrdId=$E(PrdId,1)_"."_$E(PrdId,2,4)_"."_$E(PrdId,5,7)_"."_$E(PrdId,8)
 ...Set $P(Rec,D,23)=PrdId
 ...Set $P(Rec,D,24)=PrdNm
 ...Set T=$P(Rec,D,17),$P(Rec,D,17)=$S(T=1:"/T",T=2:"/H",T=3:"/D",1:"")
 ...Set PrTot=$P(Rec,D,8)*$P(Rec,D,16)/$S(T=1:10,T=2:100,T=3:1000,1:1)
 ...Set T=$P(Rec,D,12) Set $P(Rec,D,12)=$S(T=0:"NC",T=1:"NC",1:"")
 ...Set T=$P(Rec,D,13) Set $P(Rec,D,13)=$S(T=0:"",T=1:"PS",T=2:"",1:"S")
 ...Set Prijs=$$PRIJS^Blum.RaadplegenProduct(BLID,"",KlantNr)
 ...Set PrijsK=$P(Rec,D,16)/(10**$P(Rec,D,17))
 ...Set PrijsP=$P(Prijs,D,1)/(10**$S($P(Prijs,D,2)="H":2,1:0))
 ...If PrijsK'=PrijsP Set $P(Rec,D,25,26)=$P(Prijs,D,1)_D_$S($P(Prijs,D,1)="H":"/H",1:"")
 ...Set LTA=$P(Rec,D,18),LTB=$P(Rec,D,11)
 ...If $L(LTA) Do
 ....Set LTV=$$INTDATE^vhLib.DataTypes(LTB,"DW")-$$INTDATE^vhLib.DataTypes(LTA,"DW")\7
 ....Set:LTV'>0 LTV="",LTA=""
 ....Set $P(Rec,D,18)=LTA,$P(Rec,D,19)=LTV
 ...Set Cnt=Cnt+1
 ...Set ^HULP($J+100,"L",Cnt)=Rec
 ...Set (ABRef,ToeRef,KlantRef)=""
 Do INIT^PROC("BLKALL3"_$S('$D(KlantLim):"",1:"A"),"List")
 S:$D(KlantLim) List(2,"B")=^LD("L","BLKALL3B")
 Do PRINT^OUTPUT(.List,"PS")
 Quit
 
CB(Ref) ;CallBack OUTPUT
 New Return
 Set Return=""
 If Ref'?1A,$P(@Ref,D,22) Do  
 .Set KlantNr=$P(@Ref,D,22)
 .If $D(^BLBeri("K",KlantNr)) Set HeadNm=$P(^(KlantNr),D,1),HeadAdr=$P(^(KlantNr),D,2)
 .Else  Set HeadNm="Onbekend "_KlantNr,HeadAdr=""
 .Set sTitel="KAL : "_HeadNm_D_HeadAdr
 .Set Return="PB\;"
 If Ref'?1A,$D(KlantLim) Do
 .If $P(@Ref,D,20) Set Return=$S($L(Return):"PB\",1:"")_";\;B"
 .Else  Set Return=";B"
 Quit Return
 
LLIJN 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(LevNr,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
 .If TF1?6N Set TF1=$E(TF1,5,6)_"."_$E(TF1,3,4)_"."_$E(TF1,1,2),TF1=$$EXTDATE^vhLib.DataTypes($$INTDATE^vhLib.DataTypes(TF1,"DK"),"DW")
 .Else  Set TF1=""
 Set:Piece $P(NewRec,D,Piece)=TF1
 Set:Local'="" @Local=TF1
 Set Tptr=$N(^(Tptr)) Goto TLoop
YZ Do Footer:$D(^HULP($J+100)) 
 Do CLOSE^vhPRINTER ; X F71
 Set FP=2301 Write @F,@F1
 Kill ^HULP($J+100)
 Q