BLEXPO2 G BEGIN ;Vertaling van de Toeleveringsbons naar een export-bestand; [ 12/27/2003  9:44 AM ]
 ;Parameters : 
 ; BLEXP(1)= Tabelnaam waarin de nummers van de te verzenden toeleveringen staan opgeslagen.
 ;      (2)= Alleen aanpassingen (default=empty wat betekend alles.)
 ;      (3)= Naam van de zender, def = "LVH"
 ;      (4)= Naam van de ontvanger, def = "BLUM"
 ;
 ; Invullen van de defaults
 
BEGIN Set:'$D(BLEXP(1)) BLEXP(1)="^BLBeri(""Z"""
 SET:'$D(BLEXP(2)) BLEXP(2)=""
 SET:'$D(BLEXP(3)) BLEXP(3)="PETER VDR"
 SET:'$D(BLEXP(4)) BLEXP(4)="BAU03436  "
 SET BlumNr="5005"
 G:$D(@BLEXP(1)) C1 ; Alleen indien er toeleveringen te exporteren zijn
 W "De lijst met toeleveringen is leeg,er is niets te transfereren (druk return)" R *K
 G YZ
 ;
 ; Exporteren van de bon's
C1
 Kill ^BLExport W "Bezig met het formateren in het exportformaat"
 Do TRUB
 Set BonNr=-1 ; Alle toeleveringen in lijst verwerken
 Set Type=""
 For  Set Type=$O(@BLEXP(1)@(Type)) Quit:Type=""  Do
 .Do MSB
 .For  Set BonNr=$O(@BLEXP(1)@(Type,BonNr)) Quit:BonNr=""  Do TLBon
 .Do MSETL
 Do BerichtConfirmatie ; Bevestiging van de ontvangen berichten
 Do TRUE
 
 Goto YZ
 
BerichtConfirmatie ;Berichten retour sturen 
 If $D(^BLBeri("T")) Do
 . Do MSB
 . Set I="" ; Alle ontvangen berichten verwerken
 . For  Set I=$O(^BLBeri("T",I)) Quit:I=""  Do BERI
 . Do MSEBERI
 Quit
 
CONV SET FL(2)="" DO FL^PROC SET MsgNr=MsgNr+1,RecNr=RecNr+1,^BLExport(RecNr)=R Q
 ; Transmission begin
 ; MITYPE\MIIDEF1\MIIDEF2\MIFILL
TTRUB ;@"##TRUB";C;L;6\"LVH";C;L;3\MIIDEF;0N+.;R;5\;C;L;66
TRUB SET MIIDEF=$P(^BLBeri,D,2),(MsgNr,RecNr)=0,FL(1)=$P($T(TTRUB),"@",2) GOTO CONV
 ; Transmission End
 ; MITYPE\MIIDEF1\MIIDEF2\MIFILL
TTRUE ;@"##TRUE";C;L;6\"LVH";C;L;3\MIIDEF;0N+.;R;5\;C;L;66
TRUE SET MIIDEF=$P(^BLBeri,D,2),$P(^BLBeri,D,2)=MIIDEF+1 ; Verhogen van transmissie nummer
 SET FL(1)=$P($T(TTRUE),"@",2) GOTO CONV
 ;
 ;Message BEGIN
MSB SET MsgNr=0,RecNr=RecNr+1
 Set MIIDEF=$P(^BLBeri,D,1),$P(^BLBeri,D,1)=MIIDEF+1 ;Verhogen van het MessageID nummer
 Q  ; Het record wordt bij MSGE weggeschreven
MSETL SET MIINTY="COM",MIINTS=Type,MINETC=$S(BLEXP(2):"C",1:"N"),MIACRQ=1 GOTO MSE
 ; Einde bericht : Bevestiging ontvangen berichten
MSEBERI SET MIINTY="MSG",MIINTS="  ",MINETC="N",MIACRQ="0" GOTO MSE
 ; Message BEGIN deel 1
 ; MITYPE\MIIDEF1\MIIDEF2\MICODE\MIIDTR\MIIORE\MIINTY\MIINTS\MINETC\MIOTTR\MIOTCR\MITICR\MINNCR\MISTTR\MIACRC\MIACRQ\MICOUN\MINNRE\MIFILL
TMSGB ;@"##MSGB";C;L;6\"LVH";C;L;3\MIIDEF;0N+.;R;5\"A";C;L;1\"LVH";C;L;3\"BAU";C;L;3\MIINTY;C;L;3\MIINTS;C;L;2\MINETC;C;L;1\MIOTTR;C;L;6\MIOTCR;C;L;6\MITICR;C;L;4\MINNCR;C;L;10\"6";C;L;1\;C;L;1\MIACRQ;C;L;1\MICOUN;0N0+.;R;5\MINNRE;C;L;10\;C;L;9
 ;Message END
 ; MITYPE\MIIDEF1\MIIDEF2\MIFILL
TMSGE ;@"##MSGE";C;L;6\"LVH";C;L;3\MIIDEF;0N+.;R;5\;C;L;66
MSE SET (MIOTTR,MIOTCR)=$E(DJ,3,4)_DM_DD
 SET MITICR=$P($H,",",2)\60,MITICR=$E(MITICR\60+100,2,3)_$E(MITICR#60+100,2,3)
 SET MINNCR=BLEXP(3),MICOUN=MsgNr,MINNRE=BLEXP(4)
 SET FL(1)=$p($T(TMSGB),"@",2),FL(2)="" DO FL^PROC SET ^BLExport(RecNr-MsgNr)=R
 Set ^BLBeri("O","LVH"_$E("00000",1,5-$L(MIIDEF))_MIIDEF)=MIINTY_D_MIINTS_D_DT_D_TD_D_D_MIACRQ_D_MICOUN_D
 SET FL(1)=$P($T(TMSGE),"@",2) GOTO CONV
 
 ; Bericht record
 ; PMMARK\PRMRECT\PMMSGI\PMACDT\PPACTI\PMMARK\PMFILL
TBERI ;@"""";C;L;1\"11";C;L;2\PMMSGI;C;L;8\PMACDT;C;L;6\PPACTI;C;L;4\"""";C;L;1\;C;L;58
BERI SET R=^BLBeri("T",I),$P(R,D,8)=1,^BLBeri("B",I)=R KILL ^BLBeri("T",I) 
 Q:'$P(R,D,6)  ;Alleen indien het moet bevestigd worden
 SET PMMSGI=I
 SET PMACDT=$E(DJ,3,4)_DM_DD
 SET PPACTI=$P($H,",",2)\60,PPACTI=$E(PPACTI+100,2,3)_$E(PPACTI#60+100,2,3)
 SET FL(1)=$P($T(TBERI),"@",2) GOTO CONV
 
 ; Verwerking van 1 toeleveringsbon
TLBon Q:'$D(^KTO(BlumNr,BonNr,1))  ; Bon niet aanwezig in het bestand
 Set ^BLBeri("O","LVH"_$E("00000",1,5-$L(MIIDEF))_MIIDEF,BonNr)=""
 Set FP=2450 Write @F,BonNr,"      "
 DO COMSO11 SET LijnNr=100
 Do:Type="DO" COMMENT("Orderref. : "_$P(^KTO(BlumNr,BonNr,1),D,3))
TLLijn Set LijnNr=$N(^KTO(BlumNr,BonNr,LijnNr)) Q:LijnNr=-1
 IF '$L($P(^(LijnNr),D,2)) DO COMMENT($P(^KTO(BlumNr,BonNr,LijnNr),D,5)) GOTO TLLijn
 DO COMSO21 GOTO TLLijn
 ; Comment
 ; MIMARK\MIRECT\MIREFC\MICOMM\MIMARK\MIFILL
TCOMMENT ;@"""";C;L;1\MIRECT;C;L;2\MIREFC;C;R;2\MICOMM;C;L;60\"""";C;L;1\;C;L;14
COMMENT(MICOMM) SET MIRECT=CommentNr,MIREFC=MIREFC+1
 SET FL(1)=$P($T(TCOMMENT),"@",2) GOTO CONV
 ; COM-SO-11
 ; COMARK\CORECT\COCUST\COANOD\COCUSI\COANOI\COORDR\COTRTI\COONBL\COCURR\COORRC\COTRMD\COEORD\COMARK\COFILL
TCOMSO11 ;@"""";C;L;1\"11";C;L;2\COCUST;C;L;6\COANOD;C;L;2\COCUSI;C;L;6\COANOI;C;L;2\COORDR;C;L;12\;C;L;3\COONBL;C;L;12\COCURR;C;L;3\"N";C;L;2\"L";C;L;2\COEORD;C;L;6\"""";C;L;1\;C;L;20
COMSO11 SET CommentNr=19,MIREFC=0,R=^KTO(BlumNr,BonNr,1)
 Set (COCUST,COCUSI)=$P(R,D,9)
 Set:COCUST'?5.6N!(COCUST=999250) (COCUST,COCUSI)="212250" ; Niet gedefinieerd of fictieve BLUMklant : Van Hoecke - ASOP
 Set (COANOD,COANOI,COONBL)="",COCURR="W01"
 Set COORDR=BonNr,COEORD=$P(R,D,2),COEORD=$E(COEORD,7,8)_$E(COEORD,4,5)_$E(COEORD,1,2)
 If Type="DO" Do
 .Set ^BLBeri("DO")=^BLBeri("DO")+1
 .Set:^BLBeri("DO")>919999 ^BLBeri("DO")=915010
 .Set COONBL=^BLBeri("DO") ;ABNr wordt door VAN HOECKE bepaald
 .Set $P(^KTO(BlumNr,BonNr,1),D,10)=COONBL 
 .Set COORDR=$P($P(^KTO(BlumNr,BonNr,1),D,3)," ",1)_" "_COORDR
 .If COCUST["44260"  Do  ; Bruynzeel
 ..Set COANOI="01",COANOD="02"
 ..Set (COCUST,COCUSI)="044260"
 .If COCUST="452250" Do  ; Meubar
 ..Set COANOI="01",COANOD="01"
 ..Set COCURR="W15" ; munt BEF
 SET $P(^KTO(BlumNr,BonNr,1),D,16)=DD_"."_DM_"."_$E(DJ,3,4)
 Set COPOSN=0 ; ABLNr, eerste nummer begint bij 1000
 SET FL(1)=$P($T(TCOMSO11),"@",2) Do CONV
 Quit:Type'="DO"
 Quit
 ; COM-SO-21
 ;COMARK\CORECT\COLIID\COPOSN\COIDNO\COORQT\COPRIC\COPRDI\CODELD\CODDCO\COSHST\COREAC\COIDCH\COCUID\COMARK\COFILL
TCOMSO21 ;@"""";C;L;1\"21";C;L;2\COLIID;C;L;11\COPOSN;.0N+;L;5\COIDNO;0N+.;R;8\COORQT;-0N0.;R;7\COPRIC;C;R;10\COPRDI;C;L;1\CODELD;C;L;6\;C;L;1\;C;L;1\"N";C;L;1\;C;L;1\;C;L;19\"""";C;L;1\;C;L;5
COMSO21 SET CommentNr=29,MIREFC=0,Rec=^KTO(BlumNr,BonNr,LijnNr)
 SET COLIID=BonNr_"."_$E(100+$P(Rec,D,13),2,3)
 If Type="DO" Do  ; Het ABLNr wordt door VAN HOECKE bepaald
 .Set COPOSN=COPOSN+1000
 .Kill ^KTO3(BonNr,$P(^KTO(BlumNr,BonNr,LijnNr),D,13,14)_D_LijnNr)
 .Set $P(^KTO(BlumNr,BonNr,LijnNr),D,14)=COPOSN
 .Set ^KTO3(BonNr,$P(^KTO(BlumNr,BonNr,LijnNr),D,13,14)_D_LijnNr)=""
        
 SET (COCUID,COIDNO)=$P(^KPR($P(Rec,D,2),"J"_BlumNr),D,3),(COCUID,COIDNO)=$P(COIDNO,".",1)_$P(COIDNO,".",2)_$P(COIDNO,".",3)
 SET COORQT=$P(Rec,D,3),COPRDI=$S($P(Rec,D,21)="H":2,$P(Rec,D,21)="D":3,1:0)
 Set COPRIC=$J($P(Rec,D,6)*(1-($P(Rec,D,7)/100)),0,2),COPRIC=$E("000000000",$L(COPRIC),9)_COPRIC
 SET R=$$Week2Dag($P(Rec,D,25),$S(Type="DO":3,1:1)) SET CODELD=$P(R,".",3)_$P(R,".",2)_$P(R,".",1)
 SET FL(1)=$P($T(TCOMSO21),"@",2) GOTO CONV
 
Week2Dag(WeekDatum,DagNr) ;Datum uit weeknummer en dagnummer
 S:'$G(DagNr) DagNr=1 ; Maandag
 Quit $TR($$EXTDATE^vhDTyp($$CALCDATE^vhDTyp($$INTDATE^vhDTyp(WeekDatum,"DW"),"W","FD")+DagNr-1,"DK"),"-",".")
 
 
YZ Q  ;d ^cG Q
Z X ^cZ Q
ZZ ; 01.02.91- 10 u 52