go to post Elisha Gould · Jul 28 Just as a long outstanding note.I made an extension to EnsLib.FTP.OutboundAdapter that adds handling for Use Session Resumption as a parameter, but it appears as of the 2024 version of IRIS this has been added to the core IRIS code. We've only recently been able to use it as we had an old OpenSSL version that did not support the flags required, so this has been left and not looked at in a few years.For reference the extension I wrote is listed below: Include Ensemble Class Custom.Operations.FTP.OutboundAdapter Extends EnsLib.FTP.OutboundAdapter [ ClassType = "", Inheritance = right, ProcedureBlock, System = 4 ] { Property SSLUseSessionResumption As %Boolean [ InitialExpression = 0 ]; /// These properties can be configured or set by the associated Business Operation Parameter SETTINGS = "SSLUseSessionResumption:Connection"; /// Connect to the FTP server and log in, setting the directory and transfer mode Method Connect(pTimeout As %Numeric = 30, pInbound As %Boolean = 0) As %Status { Set $ZT="Trap", tSC=$$$OK, tFTPPort=..FTPPort Do { If ..Connected { Do ..TestConnection(pInbound) Quit:..Connected } #; Connect to the FTP server If '$IsObject(..%CredentialsObj) Do ..CredentialsSet(..Credentials) If '$IsObject(..%CredentialsObj) { Set tSC=$$$ERROR($$$EnsErrNoCredentials,..Credentials) Quit } Set ..%LastSetFilePath="" #; find FTP type; get a configuration-settings instance, use it to open an FTP Session instance If ..%isSFTP { #; Connect using an SFTP object Set:""=tFTPPort tFTPPort=22 Set tIOAddr=..FTPServer_":"_tFTPPort_"/"_..Credentials_"/SSL='"_..SSLConfig_"'/PubKey='"_..SFTPPublicKeyFile_"'/PrivKey='"_..SFTPPrivateKeyFile_"'" $$$catTRACE("connwait","Connecting to "_tIOAddr_"/"_..Credentials_"'/PubKey='"_..SFTPPublicKeyFile_"'/PrivKey='"_..SFTPPrivateKeyFile_"' with timeout="_pTimeout) Set:'$IsObject(..FTP)||'..FTP.%Extends("EnsLib.FTP.CommonSSH") ..FTP=$this Set ..FTP.SSLUseSessionResumption=..SSLUseSessionResumption Set t0=$zh Set tSC=..FTP.ConnectSSH(pTimeout, pInbound, tFTPPort) } Else { #; Connect using standard FTP, or FTPS with SSLConfig Set:""=tFTPPort tFTPPort=21 Set tIOAddr=..FTPServer_":"_tFTPPort_"/"_..Credentials_"/SSL='"_..SSLConfig $$$catTRACE("connwait","Connecting to "_tIOAddr_"/"_..Credentials_" with timeout="_pTimeout) Set:'$IsObject(..FTP)||'..FTP.%Extends("%Net.FtpSession") ..FTP=##class(%Net.FtpSession).%New() Set ..FTP.SSLUseSessionResumption=..SSLUseSessionResumption Set t0=$zh, ..FTP.Timeout=pTimeout, ..FTP.UsePASV=..UsePASV, ..FTP.LegacySSL=("*"=$E(..SSLConfig,*)), ..FTP.SSLConfiguration=$S("*"=$E(..SSLConfig,*):$E(..SSLConfig,1,*-1),1:..SSLConfig) If (..FTP.SSLConfiguration'="") { Set ..FTP.SSLCheckServerIdentity = ..SSLCheckServerIdentity Set ..FTP.SSLUseSessionResumption = ..SSLUseSessionResumption } If '..FTP.Connect(..FTPServer,..%CredentialsObj.Username,..%CredentialsObj.Password,tFTPPort) { Set tSC=$$$ERROR($$$EnsErrFTPConnectFailed,tIOAddr_"/"_..Credentials,..FTP.ReturnMessage,..FTP.ReturnCode) } #; Set after connect since FTP class will query server if empty string Set ..FTP.CommandTranslateTable = ..CommandTranslateTable } If $$$ISERR(tSC) { Set tSC=$S((-1'=pTimeout)&&(t0+pTimeout<=$zh): $$$ADDSC($$$ERROR($$$EnsErrOutConnectExpired,pTimeout,$S(..%isSFTP:"SFTP",1:"FTP"),tIOAddr),tSC) , 1: $$$ERROR($$$EnsErrOutConnectFailed,$$$StatusDisplayString(tSC),$S(..%isSFTP:"SFTP",1:"FTP"),tIOAddr)) Set ..FTP=$$$NULLOREF Quit } #; Get the system declaration from the FTP server Set ..%Syst="" Set:..FTP.System(.tSystem) ..%Syst=tSystem If ""'=..%Syst { Set ..%isVMS = ("VMS " = $E(..%Syst,1,$L("VMS "))) $$$catTRACE("connwait","Detected FTP server system type '"_..%Syst_"'") } #; Set the current directory Set ..%LastSetFilePath=..fixSvrPath(..FilePath,0) If ""=..%LastSetFilePath { $$$catTRACE("connwait","Not setting FTP working directory because FilePath is empty") } Else { If ..FTP.SetDirectory(..%LastSetFilePath) { $$$catTRACE("connwait","Set FTP working directory to "_..%LastSetFilePath) } Else { Set tSC=$$$ERROR($$$EnsErrFTPDirectoryChangeFailed,..%LastSetFilePath,..FTP.ReturnMessage,..FTP.ReturnCode) Set ..%LastSetFilePath="" Quit } } #; Set the transfer mode Set tTable = "RAW" Set csetlc=$ZCVT(..Charset,"L") Set tAscii=$Case($E(csetlc,1,5),"":1,"defau":1,"ascii":1,"latin":1,"iso-8":1,"utf-8":1,:0) If 'tAscii { If '..FTP.Binary() { Set tSC=$$$ERROR($$$EnsErrFTPModeChangeFailed,"Binary",..FTP.ReturnMessage,..FTP.ReturnCode) Set ..FTP.TranslateTable = "" Quit } If "binary"'=csetlc { Set tEnc=..Charset Set:"*"=$E(tEnc) $E(tEnc)="" Set tTable = ##class(%IO.I.TranslationDevice).GetCharEncodingTable(tEnc) Set:tTable="" tTable="RAW" } } Else { If '..FTP.Ascii() { Set tSC=$$$ERROR($$$EnsErrFTPModeChangeFailed,"Ascii",..FTP.ReturnMessage,..FTP.ReturnCode) Quit } If "ascii"'=csetlc { If $Case(csetlc,"":0,"default":0,"native":0,:1) { Set tTable = ##class(%IO.I.TranslationDevice).GetCharEncodingTable(..Charset) } Else { Set tTable = "" } Set:tTable="" tTable=$$DefIO^%NLS(5) } } #; Success Set ..FTP.TranslateTable = tTable Set tTxt="Connected to FTP Server '"_tIOAddr_"' at path '"_..%LastSetFilePath_"' using Credentials '"_..Credentials_"'" If ..StayConnected<0 { $$$LOGINFO(tTxt) } Else { If pInbound&&'..StayConnected { $$$catTRACE("connwait",tTxt) } ElseIf ..%logTransfers { $$$LOGINFO(tTxt) } Else { $$$sysTRACE(tTxt) } } Set ..Connected=1 $$$ASSERT(..FTP.Connected) If (..BusinessHost.%LastReportedError [ "ERROR <Ens>ErrOutConnect") ||(..BusinessHost.%LastReportedError [ ..%LastNetErr) { Set ..BusinessHost.%LastReportedError="" $$$SetHostMonitor(..BusinessHost.%ConfigName,$$$eMonitorStatus,"OK") } Set ..%LastNetErr="%%%%%" Set i%%IOAddr=tIOAddr } While 0 Exit If $$$ISERR(tSC) { $$$ASSERT('..Connected) Do:..FTP.Connected ..FTP.Logout() ; force FTP class into sync in case it made a mistake } Quit tSC Trap Set $ZT="",tSC=$$$EnsSystemError Set tSC =$$$ERROR($$$EnsErrOutConnectException,$$$StatusText(tSC),$S(..%isSFTP:"SFTP",1:"FTP"),tIOAddr_"/"_..Credentials) Goto Exit } }
go to post Elisha Gould · May 5, 2022 Thank you, I'll have a look at it. I did open a WRC Support request about it, but still waiting to hear back if it can be added to our current release.
go to post Elisha Gould · Jun 30, 2020 For those interested. We copied part of the validation check, and updated with some options to truncate as per the schema. It can be called with: set tSC = ##class(User.Hl7RangeCheck).RangeChk(.pRequest) Include EnsHL7 Class User.Hl7RangeCheck{ ClassMethod RangeChk(ByRef pMsg As EnsLib.HL7.Message) As %Status{#dim pIndex as %Integer = 1Set tSC=$$$OK , tSC2=$$$OK, tSC1=$$$OKfor {set pSeg = pMsg.GetSegmentAt(pIndex)quit:($ZSTRIP(##class(%String).LogicalToDisplay(pSeg), "<>W" ) = "") quit:(pSeg.Name = "") //$$$ERROR($$$EnsErrGeneral, "Cannot validate segment schemas without a segment name. Unable to validate segment "_$get(pSegNum)_".")set hasSegNum = 1 - ($get(pSegNum)="")quit:(pSeg.DocTypeCategory = "") //$$$ERROR($$$EnsErrGeneral, "Cannot validate segment schemas without a category. Unable to validate segment "_$S(hasSegNum:pSegNum_":",1:"")_pSeg.Name_".") quit:($get($$$vaSchemaGbl(pSeg.DocTypeCategory, "SS", pSeg.Name)) = "") //$$$ERROR($$$EnsErrGeneral, "Unable to retrieve the schema to validate segment against. Unable to validate segment "_$S(hasSegNum:pSegNum_":",1:"")_pSeg.Name_".")set schema = $$$vaSchemaGbl(pSeg.DocTypeCategory, "SS", pSeg.Name)for fieldNum=1:1:$listlength(schema) {quit:(fieldNum > pSeg.Count)set fieldDat = pSeg.GetValueAt(fieldNum, pSeg.Separators, .tSC2)if ($$$ISERR(tSC2)) {set tSC = $$$ADDSC(tSC, $$$ERROR($$$EnsErrGeneral, "Unable to retrieve field "_fieldNum_" from segment "_$S(hasSegNum:pSegNum_":",1:"")_pSeg.Name_"."))quit ; can only continue with this field if no error in getting it}set fieldSchema = $listget(schema, fieldNum)if '(((pSeg.Name = "MSH") || (pSeg.Name = "BHS") || (pSeg.Name = "FHS")) && ((fieldNum = 1) || (fieldNum = 2))) {set dat = $tr(fieldDat, pSeg.Separators, "") ; remove separators from field}else {set dat = fieldDat}set data = (dat '= "") ; is anything left?if (data) {//if not data structures, components, subcomponents, datatypes, and/or code tablesif ($listget(fieldSchema, 1) = ""){ set len = $length(fieldDat)if (($listget(fieldSchema, 4) '= "") && (len > $listget(fieldSchema, 4))) ; over length restriction{if '(((pSeg.Name = "MSH") || (pSeg.Name = "BHS") || (pSeg.Name = "FHS")) && (fieldNum = 2)) {for rep=1:1:($length(fieldDat, pSeg.RS)) {if ($length($p(fieldDat, pSeg.RS, rep)) > $listget(fieldSchema, 4)) { set tSC = pMsg.SetValueAt(..Truncate(pMsg.GetValueAt(pSeg.Name_":"_fieldNum_"("_rep_")"),$listget(fieldSchema, 4)) , pSeg.Name_":"_fieldNum_"("_rep_")")}} } }}else {k infoset info("SegName") = pSeg.Name , info("fieldNum") = fieldNum, info("sep") = pSeg.Separatorsset (info("rep"), info("comp"), info("subComp")) = 1 set:(hasSegNum) info("SegNum") = pSegNumset info("hasSegNum") = hasSegNum if ($listget(fieldSchema, 1) '= "") ; there is a data structure for the field{set dataStruct = $listget(fieldSchema, 1)set tSC = ..ValidateFieldDataStructure(.pMsg,fieldDat, dataStruct, .info)}}}} set pIndex = pIndex+1}return tSC} ClassMethod ValidateFieldDataStructure(ByRef pMsg As EnsLib.HL7.Message, field As %String, struct As %String, ByRef info) As %Status [ Internal ]{set tSC = $$$OK, error = 0set category = $p(struct, ":", 1)set dataStruct = $p(struct, ":", 2) quit:((category = "") || (dataStruct = "")) $$$ERROR($$$EnsErrGeneral, "Cannot find schema for data structure "_struct_". Unable to validate segment "_$S($get(info("SegNum"))'="":info("SegNum")_":",1:"")_info("SegName")_" field "_info("fieldNum")_" against this structure.")set structure = $get($$$vaSchemaGbl(category, "DT", dataStruct))quit:('$data(structure)) $$$ERROR($$$EnsErrGeneral, "Cannot find schema for data structure "_struct_". Unable to validate segment "_$S(info("hasSegNum"):info("SegNum")_":",1:"")_info("SegName")_" field "_info("fieldNum")_" against this structure.") if '(((info("SegName") = "MSH") || (info("SegName") = "BHS") || (info("SegName") = "FHS")) && (info("fieldNum") = 2)) {for info("rep") = 1:1:$length(field, $$$RSSEP(info("sep"))) {set repeat = $piece(field, $$$RSSEP(info("sep")), info("rep"))for info("comp")=1:1:$length(repeat, $$$CSSEP(info("sep"))) {quit:(info("comp") > $listlength(structure))set component = $piece(repeat, $$$CSSEP(info("sep")), info("comp"))set dat = $tr(component, $$$SSSEP(info("sep"))) ; remove separators from fieldset data = (dat '= "") ; is anything left?if (data) {set len = $length(component)if (($listget($listget(structure, info("comp")),3)'="") && (len > $listget($listget(structure, info("comp")),3))) ; over length restriction { set tSC = pMsg.SetValueAt(..Truncate(component,$listget($listget(structure, info("comp")),3)), info("SegName")_":"_info("fieldNum")_"("_info("rep")_")"_"."_info("comp"))}}}}}Return tSC} ClassMethod Truncate(pString As %String, pNum As %Integer) As %String{#dim tString As %String = pString If ($LENGTH(pString) > pNum){Set tString = $EXTRACT(pString,1,pNum)} Return tString} }
go to post Elisha Gould · May 26, 2020 Hi, It's a few particular down stream applications that have strict limits on its field sizes. I can't just drop the message if it doesn't conform as they still require the data, and it is valid output from the source system. I know I could update the DTL to go through every field and truncate as needed, however that would need every field to have the limit put on it, which gets a bit excessive with the number of fields that need the limit placed on. I was mainly trying to see if there was something already existing that was able to just use the schema before I went down that rabbit hole.