TRANSPI ;ABX-EDI Inlezen en verwerking van fakturatiegegevens [ 11/29/2003 8:10 AM ] #Define MailFrom "EDI ABX " #Define MailTo $LB("PV@VanHoecke.be") q KILLALL k ^LEVBS s ^LEVBS("N")=0 ;Do VERWERK Quit VERWERK ; Selectie, verwerken van 1 EDI-bestand en opkuisen archive New Local,File,Dir,MSMGATEWAY Set MSMGATEWAY=##Class(TECH.Config.ConfigMgr).Instance().GetString("MSMGATEWAY") Set Dir=MSMGATEWAY_"\ABX_IN\" Write @F11,@F1,@FMTB," IMPORT ABX FACTURATIE - ",QN," ",@FMTb Set FP=2401 Write @F,@F1,"Ingave van het te importeren bestand" Set File=$$DISPDIR^vhDEV(Dir,"*.TXT") Do:$L(File) CONVERT(Dir,File,1) ; verwerken ;Verwijder oude archives ;Do SCANDIR^vhDEV(Dir_"ARCHIVE\","*.*",$NA(Local),"X",90) Quit SCAN ; Achtergrond job dat alle EDI-bestanden verwerkt Set Q="K" D ^cA604 Set $zt="TrapCatch^TRANSPI" Set MSMGATEWAY=##Class(TECH.Config.ConfigMgr).Instance().GetString("MSMGATEWAY") Set Dir=MSMGATEWAY_"\ABX_IN\" Do SCANDIR^vhDEV(Dir,"*.*",$NA(Local),"") Set File="" For Set File=$O(Local(File)) Quit:File="" Do . Do CONVERT(Dir,File,1) ; verwerken ; Verwijder oude archives ;Do SCANDIR^vhDEV(Dir_"ARCHIVE\","*.*",$NA(Local),"X",90) ; Controle Kill Local Do SCANDIR^vhDEV(Dir,"*.*",$NA(Local)) If $L($O(Local(""))) Do ; Na het verwerken zijn er nog bestanden . Do WARN^vhTXTPOP("Er zijn nog bestanden niet verwerkt "_Dir,,1) Quit TrapCatch Set Error=$ZE Set Tekst="FileNaam = "_$G(FileNm) Set Tekst=Tekst_$C(13)_"Aantal records bewaard = "_$G(CountSave) Set Tekst=Tekst_$C(13)_"Aantal records gekoppeld aan transport = "_$G(CountTrans) Set Tekst=Tekst_$C(13)_"In TrapCatch^TRANSPI $ZE = "_Error Do SendMiniMail^vhLib($$$MailFrom,$$$MailTo,"Import Transport - #ERROR#",Tekst) Quit CONVERT(DirR,FileNm,Muet) ; Inlezen van bestand en elke record verwerken New Dev,RNext,C,Error,BSId,BSRec,TRANSPNr Set Skip=0 Set FaktRun=0 ; Niet verwerken indien geen faktuurgegevens Set (CountSave,CountTrans)=0 ; Globale tellers van hoeveel er gesaved werd en hoeveel er gekoppeld werd met het transport Set FileNm=$$READ^vhDEV(DirR,FileNm,"D`CONVONE^"_$ZN,"M") Set Status=$$MOVEFILE^vhDEV(DirR,FileNm,DirR_"ARCHIVE\") ; verplaatsen naar archive Do:CountSave MAIL(FileNm,CountSave,CountTrans) ; e-mailen alleen als er correcte data in het bestand zit, er worden veel dummy bestanden toegestuurd Quit MAIL(FileNm,CountSave,CountTrans) Set Tekst="FileNaam = "_FileNm Set Tekst=Tekst_$C(13)_"Aantal records bewaard = "_CountSave Set Tekst=Tekst_$C(13)_"Aantal records gekoppeld aan transport = "_CountTrans Do SendMiniMail^vhLib($$$MailFrom,$$$MailTo,"Import Transport "_FileNm,Tekst) Quit CONVONE(Rec) ; Conversie van 1 record en verwerking ervan ; Callback vanuit READ^vhDEV New Kode,RNext Quit:Skip Set Kode=$E(Rec,1,3) Do TRANSREC(Rec,Kode) Do CALL Quit TRANSREC(Rec,Kode) New Pos,LNext,LRec,Label,Len,Type,Piece,Pos Set Pos=4 Kill C Set C=Kode Set Kode="A"_Kode ; alle kodes van ABX beginnen met een extra 'A' For LNext=1:1:$O(^EWREC("D",Kode,""),-1) Do .Set LRec=^EWREC("D",Kode,LNext) .Set Label=$P(LRec,D,1) .Set Len=$P(LRec,D,2) .Set Type=$P(LRec,D,3) .Set Dec=$P(LRec,D,4) .Set Piece=$E(Rec,Pos,Pos+Len\1-1) .Set Pos=Pos+Len\1 .If Type="N" Set C(Label)=$$ADDNUM(Piece,Dec) Quit .If Type="N-" Set C(Label)=$$ADDNUM(Piece,Dec) Quit .If $E(Type)="D" Set C(Label)=$$ADDDAT(Piece) Quit .If Type="T" Set C(Label)=$$ADDTIME(Piece) Quit .Set C(Label)=$$ADDALFA(Piece) Quit CALL ; Nakijken of er een routine aan het wachten is, anders oproepen van de respectievelijke routine Quit:";HIA;RUN;SHI;KOS;TOT;"'[(";"_C_";") Goto @C Quit HIA Quit RUN ; Fakturatie run If $D(BSRec) Do SAVE ; Indien BSRec ingevuld dan de vorige bouwsteen eerst opslaan Set TransFRef=C("FAKTNR") Set LEVNr=5036 ; ABX Set FaktRun=1 ; Beginnen met verwerken Merge RunC=C Quit SHI ; Adres Quit:'FaktRun ; Niet verwerken If $D(BSRec) Do SAVE ; Indien BSRec ingevuld dan de vorige bouwsteen eerst opslaan ; Initialisatie bouwsteen Kill BSRec Set $P(BSRec,D,1)="T" ; Transport Set BSId="" Set TRANSPNr="" ; Initialisatie van adres Set BSRec("A")="" Set $P(BSRec("A"),D,2)=C("NAAM") Set $P(BSRec("A"),D,5)=C("STRAAT")_$S($L(C("NUMMER")):" "_C("NUMMER"),1:"")_$S($L(C("BUS")):" "_C("BUS"),1:"") Set $P(BSRec("A"),D,6)=C("POSTCODE") Set $P(BSRec("A"),D,7)=C("WOONPLAATS") Set $P(BSRec("A"),D,8)=C("LAND") Quit KOS ; Kosten Quit:'FaktRun ; Niet verwerken Set:$G(TRANSPNr)="" TRANSPNr=$$ZOEKTRP(C("REFAFZEND")) ; Eerste keer dat TRANSPNr bestaat dan het hoofdrecord invullen If $P($G(BSRec),D,6)="",TRANSPNr Do . Set KLNr=$P(^TRANSP("D",TRANSPNr,"D",C("REFAFZEND")),D,1) . Set $P(BSRec,D,2)=KLNr . Set $P(BSRec,D,3)=C("DATPRESTATIE") . Set $P(BSRec,D,6)=TRANSPNr . Set $P(BSRec,D,7)=C("REFAFZEND") . Do GETDOCS(.BSRec,TRANSPNr,C("REFAFZEND")) ; Invullen transportdetails Set $P(BSRec,D,5)=$P(BSRec,D,5)+C("BEDRAGKOST") ; totaliseren kost Set R="" Set $P(R,D,1)=TransFRef Set $P(R,D,2)=C("REFABX") Set $P(R,D,3)=C("FACTTYPE") Set $P(R,D,4)=C("AARDPRESTATIE") Set $P(R,D,5)=C("DATPRESTATIE") Set $P(R,D,8)=C("ABXPROD") Set $P(R,D,9)=C("#COLLI") Set $P(R,D,10)=C("#PALLET") Set $P(R,D,11)=C("#ROLLS") Set $P(R,D,12)=C("#EENH1") Set $P(R,D,13)=C("#EENH2") Set $P(R,D,14)=C("AARDKOST") Set $P(R,D,15)=C("#EENHTAXATIE") Set $P(R,D,16)=C("EENHTYPE") Set $P(R,D,17)=C("GEWICHTTAXATIE") Set $P(R,D,18)=C("BEDRAGKOST") Set $P(R,D,19)=C("BTW") Set $P(R,D,20)=C("REMBBEDRAFZ") Set $P(R,D,21)=C("REMBBEDRBEST") Set VolgNr=$O(BSRec("T",""),-1)+1 ; eerst volgend nummer Set BSRec("T",VolgNr)=R Quit TOT ; Totaal If $D(BSRec) Do SAVE ; Indien BSRec ingevuld dan de vorige bouwsteen eerst opslaan New Rec Set Rec="" Set $P(Rec,D,1)=$H Set $P(Rec,D,2)=RunC("DATVAN") Set $P(Rec,D,3)=RunC("DATTOT") Set $P(Rec,D,4)=RunC("DATVERVAL") Set $P(Rec,D,5)=C("FACTBEDRAG") Set $P(Rec,D,6)=C("FACTBTW") Set $P(Rec,D,7)=C("CREDITBEDRAG") Set $P(Rec,D,7)=C("CREDITBTW") Set $P(Rec,D,8)=C("REMBBEDRAGAFZ") Set $P(Rec,D,9)=C("REMBBEDRAGBEST") Set ^TRANSP("F",LEVNr,TransFRef)=Rec Quit SOMTOT(Van,Tot,LEVNr) Set LEVNr=$G(LEVNr,5036) ; Default ABX Set TransFRef="" Set (SomFakt)="" For Set TransFRef=$O(^TRANSP("F",LEVNr,TransFRef)) Quit:TransFRef="" Do . Set RecF=^TRANSP("F",LEVNr,TransFRef) . Set SomFakt=SomFakt+$P(RecF,D,5) Quit $LB(SomFakt) TXT ;Write C Quit TRL ;Write C If $D(BSRec) Do SAVE Quit SAVE ; Opslaan van een volledige bouwsteen en opbouw van de indexen Set CountSave=CountSave+1 Set BSId=$$SAVEBS^LEVBS(,.BSRec) Do UPDTRANS(BSId,.CountTrans) Kill BSRec Quit UPDTRANS(BSId,CountTrans) ; Update van ^TRANSP met de link nr BSId New Rec,TRANSPNr,BONNr Set Rec=^LEVBS("D",BSId) Set TRANSPNr=$P(Rec,D,6) Set BONNr=$P(Rec,D,7) Quit:'TRANSPNr!'BONNr Lock +^TRANSP("D",TRANSPNr,"D",BONNr) Set Rec=$G(^TRANSP("D",TRANSPNr,"D",BONNr)) Quit:Rec="" Set $P(Rec,D,4)=BSId Set CountTrans=CountTrans+1 Set ^TRANSP("D",TRANSPNr,"D",BONNr)=Rec Lock -^TRANSP("D",TRANSPNr,"D",BONNr) Quit GETDOCS(BSRec,TRANSPNr,BONNr) ; Ophalen van de gekoppelde leveringsbon met de respectievelijke fakturen en of proforma ; BSRec via .Local New BONNr2,DocRec,FAKRec,VolgNr Set VolgNr=0 Set BONNr2="" For Set BONNr2=$O(^TRANSP("D",TRANSPNr,"D",BONNr,"B",BONNr2)) Quit:BONNr2="" Do . Set DocRec="" . Set $P(DocRec,D,3)=BONNr2 . Set FAKRec=$G(^KU1(BONNr2,"F")) . Set $P(DocRec,D,1+(("P"=$P(FAKRec,D,3))!("P"=$P(FAKRec,D,3))))=$P(FAKRec,D,2) . Set VolgNr=$O(BSRec("D",""),-1)+1 ; eerst volgend nummer . Set BSRec("D",VolgNr)=DocRec Set $P(BSRec,D,8)=VolgNr ; aantal documenten records Quit ZOEKTRP(BONNr) ; Zoeken in de verschillende transporten welk dat de vermelde bonnr bevat Quit:BONNr'?6N "" Set TRPNr="" For Set TRPNr=$O(^TRANSP("D",TRPNr),-1) Quit:TRPNr="" Quit:$D(^TRANSP("D",TRPNr,"D",BONNr)) Quit TRPNr TRAPEXEC Do ERROR^EWLOG($T(ERROR)) Quit TRAPFILE If $P($ZERROR,">")="