EWRECS ;E'WMS Versturen van record naar E'WMS [ 04/09/2003  9:35 AM ]
 ;
OPEN() ; Openen van een DeviceHandle
 ; Return : DeviceHandle
 New DH
 Lock +^EWREC("DH")
 Set DH=$G(^EWREC("DH"))+1
 Set:DH>999999 DH=1
 Set ^EWREC("DH")=DH
 Lock -^EWREC("DH")
 Kill ^EWREC("DH",DH)
 Quit DH
 
PUT(DH,Ref) ; Opslaan van records in een cache per DeviceHandle
 New Cnt,Key
 Set Cnt=$O(^EWREC("DH",DH,""),-1) ;Laatst gebruikte nummer
 If $G(@Ref)?1A1(1"P"1N,2N) Do  ; Slechts 1 record
 .Set Cnt=Cnt+1
 .Merge ^EWREC("DH",DH,Cnt)=@Ref
 Else  Do  ; Meerdere records
 .Set Key=""
 .For  Set Key=$O(@Ref@(Key)) Quit:Key=""  Do
 ..Quit:$G(@Ref@(Key))'?1A2N  ; Geen goede record kode
 ..Set Cnt=Cnt+1
 ..Merge ^EWREC("DH",DH,Cnt)=@Ref@(Key)
 Quit
 
GetFileNm()
 New Tijd,FileNm,OldFileNm
 Set Tijd=$H
 Set FileNm=$$EXTDATE^vhLib.DataTypes($H,"J4")_$E(100+$$EXTDATE^vhLib.DataTypes($H,"MN"),2,3)_$E(100+$$EXTDATE^vhLib.DataTypes($H,"DMN"),2,3)
 Set Tijd=$$EXTTIME^vhLib.DataTypes($P($H,",",2),"TKS")
 Set FileNm=FileNm_$E(100+$P(Tijd,":",1),2,3)_$E(100+$P(Tijd,":",2),2,3)_$E(100+$P(Tijd,":",3),2,3)
 ; Indien filenm reeds bestaat dan moet het volgnr verhoogt worden.
 Set OldFileNm=$P($G(^EWREC("S")),D,2) ; Send last file
 If ("F"_$P(OldFileNm,"."))'=("F"_$P(FileNm,".")) Set FileNm=FileNm_".000"
 Else  Set FileNm=FileNm_"."_$E(1000+$P(OldFileNm,".",2)+1,2,4)
 Set $P(^EWREC("S"),D,2)=FileNm ; Bijhouden laatst gebruikte filenaam
 Set:+$E(OldFileNm,1,8)<+$E(FileNm,1,8) $P(^EWREC("S"),D)=0 ; Elke dag resetten
 Quit FileNm
 
CLOSE(DH,NoStore,NoMove,ParmRef,FileNm) ; Wegschrijven van de cache naar een tekstbestand
 ; optioneel NoStore : De records worden niet gecopieerd naar EWREC("S")
 ; Optioneel NoMove  : De files komen niet in een tijdelijke folder, wordt gebruikt voor ABX
 ; Optioneel ParmRef : Waar moeten de parameters gehaald worden, default "P"
 ; Optioneel FileNm  : Bestandsnaam
 New Tijd,Dir,TempDir,OldFileNm,Rec,X,Files
 Set NoStore=$G(NoStore),NoMove=$G(NoMove),ParmRef=$G(ParmRef,"P"),FileNm=$G(FileNm)
 Quit:$O(^EWREC("DH",DH,""))="" ;Geen records ingevuld
 Lock +^EWREC("S")
 Set TempDir=##class(TECH.Config.ConfigMgr).Instance().GetString("WMSExchange_RootDir")_^EWREC(ParmRef,$S(NoMove:"DIRS",1:"DIRTEMPS"))
 Set:FileNm="" FileNm=$$GetFileNm()
 Set Dev=$$OPEN^vhDEV(TempDir,FileNm,"W","M")
 If 0[Dev Do ERROR^EWLOG($T(NOOPEN)) Quit
 Use Dev
 ; Een voor een de records tranformeren en wegschrijven naar bestand op de lokale schijf
 Set RNext=$P($G(^EWREC("S"),-1),D) ; Nieuw volgnummer
 For DNext=1:1:$O(^EWREC("DH",DH,""),-1) Do
 .Set RNext=RNext+1
 .Set Rec=$$TRANSREC(DH,DNext,RNext,ParmRef)
 .Do WRITEREC(FileNm,RNext,Rec,NoStore)
 Set $P(^EWREC("S"),D)=RNext ; Record nummer voor logging
 Close Dev
 ; Copieren van het tijdelijk bestand naar E'WMS (ook de achtergebleven bestanden)
 If 'NoMove Do  ; Niet bij ABX wel bij EWMS
 . Set X=$$MOVEFILE^vhDEV(TempDir,"*.*",##class(TECH.Config.ConfigMgr).Instance().GetString("WMSExchange_RootDir")_^EWREC(ParmRef,"DIRS"),"")
 . If X Do ERROR^EWLOG($T(NOMOVE))
 . ; De FTP van het WMS kijkt alleen naar de bestanden met extensie .txt
 . ; ook de achtergebleven bestanden zonder .txt extensie moeten omgezet worden
 . Do SCANDIR^vhDEV(##class(TECH.Config.ConfigMgr).Instance().GetString("WMSExchange_RootDir")_^EWREC(ParmRef,"DIRS"),"*.*","Files","L") ; ophalen van bestandsnamen in lowercase
 . Set FileNm=""
 . For  Set FileNm=$O(Files(FileNm)) Quit:FileNm=""  Do
 . . Quit:FileNm[".txt" ; reeds gerenamed
 . . Set X=$$RENFILE^vhDEV(##class(TECH.Config.ConfigMgr).Instance().GetString("WMSExchange_RootDir")_^EWREC(ParmRef,"DIRS"),FileNm,FileNm_".txt")
 . . If X Do ERROR^EWLOG($T(NOREN))
 Lock -^EWREC("S")
 Kill ^EWREC("DH",DH) ; Opkuis
 Quit
 
ZEND(Ref,NoStore,NoMove,ParmRef) 
 New DH
 Set DH=$$OPEN()
 Do PUT(DH,Ref)
 Do CLOSE(DH,$G(NoStore),$G(NoMove),$G(ParmRef,"P"))
 Quit
 
TRANSREC(DH,DNext,RNext,ParmRef) 
 New Rec,RecKode,LNext,Typ,Value,Len,RecId
 Set ParmRef=$G(ParmRef,"P")
 Set RecId=$G(^EWREC(ParmRef,"RECID"),1)
 Set RecKode=^EWREC("DH",DH,DNext)
 Set Rec=""
 Do:RecId
 .Do ADDALFA(.Rec,RecKode,3,ParmRef)
 .Do ADDNUM(.Rec,RNext,10,0,ParmRef)
 For LNext=1:1:$O(^EWREC("D",RecKode,""),-1) Do
 .Set LRec=^EWREC("D",RecKode,LNext)
 .Set Value=$G(^EWREC("DH",DH,DNext,$P(LRec,D,1)))
 .Set Len=$P(LRec,D,2)
 .Set Typ=$P(LRec,D,3)
 .If Typ="N" Do ADDNUM(.Rec,Value,Len\1,$P(Len,".",2),ParmRef) Quit
 .If Typ="DT" Do ADDDAT(.Rec,Value,Len,ParmRef) Quit
 .If Typ="TD" Do ADDTIME(.Rec,Value,Len,ParmRef) Quit
 .Do ADDALFA(.Rec,Value,Len,ParmRef)
 Quit Rec
 
ADDALFA(Rec,Value,Len,ParmRef) 
 New Format
 Set ParmRef=$G(ParmRef,"P")
 Set Format=$G(^EWREC(ParmRef,"FMTALFA"))
 If Format="" Set Rec=Rec_$E(Value,1,Len)_$J("",Len-$L(Value))
 Else  Xecute "Set Rec=Rec_"_Format
 Quit
 
ADDNUM(Rec,Value,Len,Dec,ParmRef) 
 New Value1,Value2,Format
 Set ParmRef=$G(ParmRef,"P")
 Set Format=$G(^EWREC(ParmRef,"FMTNUM"))
 If Format="" Do
 .Set Value=$J(+Value,0,Dec)
 .If Dec Do
 ..Set Value1=Value\1
 ..Set Value2=Value-Value1*(10**Dec)
 ..Set Rec=Rec_$J("",Len-$L(Value1))_$E(Value1,1,Len)
 ..Set Rec=Rec_$E($TR($J(Value2,Dec)," ",0),1,Dec)
 .Else  Do
 ..Set Rec=Rec_$J("",Len-$L(Value))_$E(Value,1,Len)
 Else  Xecute "Set Rec=Rec_"_Format
 Quit
 
ADDDAT(Rec,Value,Len,ParmRef) ; Omzetten van Datum of Datum en Tijd
 New Dat,Tijd,Format
 Set ParmRef=$G(ParmRef,"P")
 Set Format=$G(^EWREC(ParmRef,"FMTDAT"))
 If Format="" Do
 .If +$P(Value,".")=0 Set Dat="00000000"
 .Else  Set Dat=$$EXTDATE^vhLib.DataTypes(Value,"J4")_$E(100+$$EXTDATE^vhLib.DataTypes(Value,"MN"),2,3)_$E(100+$$EXTDATE^vhLib.DataTypes(Value,"DMN"),2,3)
 .If +$P(Value,".",2) Set Tijd="000000"
 .Else  Do
 ..Set Tijd=$$EXTTIME^vhLib.DataTypes($P(Value,",",2),"TKS")
 ..Set Dat=Dat_$E(100+$P(Tijd,":",1),2,3)_$E(100+$P(Tijd,":",2),2,3)_$E(100+$P(Tijd,":",3),2,3)
 .Set Rec=Rec_$J("",Len-$L(Dat))_$E(Dat,1,Len)
 Else  Xecute "Set Rec=Rec_"_Format
 Quit
 
ADDTIME(Rec,Value,Len,ParmRef) ; Omzetten van Tijd
 New Tijd,Format
 Set ParmRef=$G(ParmRef,"P")
 Set Format=$G(^EWREC(ParmRef,"FMTTIME"))
 If Format="" Do
 .If +$P(Value,".",2) Set Tijd="000000"
 .Else  Do
 ..Set Tijd=$$EXTTIME^vhLib.DataTypes($P(Value,",",2),"TKS")
 ..Set Tijd=$E(100+$P(Tijd,":",1),2,3)_$E(100+$P(Tijd,":",2),2,3)_$E(100+$P(Tijd,":",3),2,3)
 .Set Rec=Rec_$J("",Len-$L(Tijd))_$E(Tijd,1,Len)
 Else  Xecute "Set Rec=Rec_"_Format
 Quit
 
WRITEREC(FileNm,RNext,Rec,NoStore) 
 New Cnt
 Write Rec,!
 Quit:$G(NoStore)  ; Niet opslaan in EWREC("S")
 If $L(Rec)<510 Set ^EWREC("S",FileNm,RNext)=Rec
 Else  Do
 .Set Cnt=0
 .For  Quit:Rec=""  Do
 ..Set Cnt=Cnt+1
 ..Set ^EWREC("S",FileNm,RNext,Cnt)=$E(Rec,1,510)
 ..Set $E(Rec,1,510)=""
 Quit
 
ACTIVATE(NoLckWrn) 
 New %TC,SendStat,Asked,Text,Button
 Do ADD^vhLock($NA(^EWREC("P","NOSEND")))
 Set SendStat=$G(^EWREC("P","NOSEND")),Asked=0
 If %TC Do
 .Set Text=$P("aktief\niet aktief",D,SendStat+1)
 .Set Button=$P("Deaktiveren\Aktiveren",D,SendStat+1)
 .Set SendStat=$$^vhTXTPOP("EWRECS","ACTIVATE",,Text,Button),Asked=1
 .Do:SendStat'=""
 ..If $P($H,",",2)>$$INTTIME^vhLib.DataTypes("08:00"),'$$ASK^vhWACHTW("MANAGER",,,0) Quit
 ..Set ^EWREC("P","NOSEND")='$G(^EWREC("P","NOSEND"))
 .Do REMOVE^vhLock($NA(^EWREC("P","NOSEND")))
 Else  Do:'$G(NoLckWrn) LDISP^vhLock("^EWREC(""P"",""NOSEND"")","WSM-link")
 Set SendStat=$G(^EWREC("P","NOSEND"))
 Quit SendStat_D_Asked
 
WMSACTIV() 
 New R,WMSStat
 Set WMSStat=+$G(^EWREC("P","NOSEND"))
 If WMSStat Do
 .Set WMSStat=$$ACTIVATE^EWRECS(1)
 .If $P(WMSStat,D),'$P(WMSStat,D,2) Set R=$$^vhTXTPOP("EWRECS","NOTACTIV")
 Quit 'WMSStat
 
 ; Errormeldingen
NOOPEN ;"Can file niet openen voor schrijven "_TempDir_";"_FileNm
NOMOVE ;"Fout in Move file "_FileNm_" from "_TempDir_" to "_##class(TECH.Config.ConfigMgr).Instance().GetString("WMSExchange_RootDir")_^EWREC($G(ParmRef,"P"),"DIRS")_";"_X
NOREN ;"Fout in rename file "_FileNm_" from "_TempDir_" to "_##class(TECH.Config.ConfigMgr).Instance().GetString("WMSExchange_RootDir")_^EWREC($G(ParmRef,"P"),"DIRS")_";"_X
NODEL ;"Fout in Del file from tempdir "_X