Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHUVUT

INHUVUT.m

Go to the documentation of this file. 
  1. INHUVUT ; DGH,FRW,CHEM,WAB ; 06 Aug 1999 14:39; Generic TCP/IP socket utilities 
  1.  ;;3.01;BHL IHS Interfaces with GIS;**16**;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ;
  1. NEXT(INDEST,INPRI,INHOR,INPEND) ;Return next transaction in the queue for destination
  1.  Q $$NEXT^INHUVUT3(INDEST,.INPRI,.INHOR,.INPEND)
  1.  ;
  1. SEND(INUIF,INIPPO,INIP) ;Send a message from INTHU to a socket
  1.  ;More Generic 16-Apr-99 because it
  1.  ;1) includes INIP variables for message framing.
  1.  ;2) encrypts outgoing messages if the encryption flag is on.
  1.  ;INPUT:
  1.  ; INTHU=entry in ^INTHU
  1.  ; INIPPO=socket
  1.  ; INIP=array containing parameters (PBR). Key parameters are:
  1.  ; INIP("SOM")= start of message
  1.  ; INIP("EOL")=end of line (end of segment)
  1.  ; INIP("EOM")=end of message
  1.  ; INIP("CRYPT")=encryption flag
  1.  ; INIP("DESKEY")=DES key
  1.  ;OUTPUT:
  1.  ;0 if successful, 1 if error
  1.  N %,LCT,LINE,EOL,I,INDELIM,INBUF,INCRYPT,INFIRST,INLAST
  1.  S EOL=INIP("EOL"),INDELIM=$$FIELD^INHUT(),INFIRST=1
  1.  ;Set maximum string length dependent upon whether encryption is on
  1.  S INMAX=$S('INIP("CRYPT"):508,1:328),INBUF=""
  1.  ;Write message
  1.  ;;NOTE: APCOTS requested we concatenate "^" to end of segment.
  1.  S (%,LCT)=0 F  D GETLINE^INHOU(INUIF,.LCT,.LINE) Q:'$D(LINE)  D
  1.  .I $D(LINE)<10 D
  1.  ..;remove control characters if they exist
  1.  ..I LINE?.E1C.E S LINE=$$NOCTRL^INHUTIL(LINE)
  1.  ..S LINE=LINE_INDELIM
  1.  .;copy main line
  1.  .S X=$$PACK^INCRYP(LINE,INMAX,.INBUF)
  1.  .;Don't send unless X has length
  1.  .I $L(X) D
  1.  ..S %=%+1
  1.  ..I INIP("CRYPT") D
  1.  ... S INLAST=$S($D(LINE)>9:0,$D(^INTHU(INUIF,3,LCT+1,0)):0,1:1)
  1.  ... D ENCRYPT^INCRYPT(X,.INCRYPT,$L(X),INFIRST,INLAST)
  1.  ... S X=INCRYPT,INFIRST=0
  1.  ..;SOM needed for first packet
  1.  ..S:%=1 X=INIP("SOM")_X
  1.  ..D SEND^%INET(X,INIPPO,1)
  1.  .;Copy overflow nodes
  1.  .F I=1:1 Q:'$D(LINE(I))  D
  1.  ..;remove control characters if they exist
  1.  ..I LINE(I)?.E1C.E S LINE(I)=$$NOCTRL^INHUTIL(LINE(I))
  1.  ..;If no line following set delim at end
  1.  ..I '$D(LINE(I+1)) S LINE(I)=LINE(I)_INDELIM
  1.  ..S X=$$PACK^INCRYP(LINE(I),INMAX,.INBUF)
  1.  ..;don't send unless X has length
  1.  ..Q:'$L(X)
  1.  ..S %=%+1
  1.  ..I INIP("CRYPT") D
  1.  ... S INLAST=$S($D(LINE(I+1)):0,$D(^INTHU(INUIF,3,LCT+1,0)):0,1:1)
  1.  ... D ENCRYPT^INCRYPT(X,.INCRYPT,$L(X),INFIRST,INLAST)
  1.  ... S X=INCRYPT,INFIRST=0
  1.  ..S:%=1 X=INIP("SOM")_X
  1.  ..D SEND^%INET(X,INIPPO,1)
  1.  .;Add segment terminator to this line
  1.  .S X=$$PACK^INCRYP(INIP("EOL"),INMAX,.INBUF)
  1.  .Q:'$L(X)
  1.  .S %=%+1
  1.  .I INIP("CRYPT") D
  1.  .. S INLAST=$S($D(^INTHU(INUIF,3,LCT+1,0)):0,1:1)
  1.  .. D ENCRYPT^INCRYPT(X,.INCRYPT,$L(X),INFIRST,INLAST)
  1.  .. S X=INCRYPT,INFIRST=0
  1.  .S:%=1 X=INIP("SOM")_X
  1.  .D SEND^%INET(X,INIPPO,1)
  1.  ;If there's no encryption, send what's in buffer and quit
  1.  S X=INBUF
  1.  S:$L(X) %=%+1
  1.  I $L(X),INIP("CRYPT") D
  1.  . D ENCRYPT^INCRYPT(X,.INCRYPT,$L(X),INFIRST,1)
  1.  . S X=INCRYPT,INFIRST=0
  1.  S X=$S(%=1:INIP("SOM"),1:"")_X_INIP("EOM")_INIP("EOL")
  1.  D SEND^%INET(X,INIPPO,1)
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Message "_$G(INUIF)_" sent.",5)
  1.  Q 0
  1.  ;
  1. SENDSTR(STR,INIPPO) ;Sends a initiation string to socket
  1.  ;INPUT:
  1.  ; STR = initiation string (such as $C(11))
  1.  ; INIPPO=socket
  1.  ;Write initiation
  1.  D SEND^%INET(STR,INIPPO,1)
  1.  Q
  1.  ;
  1.  ;Tags OPEN, ADDR, PORT are used to find and open a socket
  1. OPEN(INBPN,INCHNL,INERR,INMEM) ;Open socket for destination
  1.  ;INPUT:
  1.  ; INBPN = background process file
  1.  ; INCHNL=channel opened (1st param)
  1.  ; INMEM=memory location (2nd)
  1.  ; INERR=error array
  1.  ;
  1.  N INOUT
  1.  S INOUT=$$OPEN^INHUVUT2(INBPN,.INCHNL,.INERR,.INMEM)
  1.  Q INOUT
  1.  ;
  1.  ;---tags RECEIVE, PARSE, R2 read entries from socket
  1. RECEIVE(INV,INCHNL,INIP,INERR,INMEM) ;Read socket
  1.  ;16-Apr-1999 Added support for decryption of incoming messages
  1.  ;if the encryption flag is set.
  1.  ;INPUT
  1.  ; INV=Location to store message, pass by reference
  1.  ; INCHNL=socket
  1.  ; INIP=array of parameters, PBR
  1.  ; INERR=error array, PBR
  1.  ; INMEM=not used (placeholder.  %INET secondary memory)
  1.  ;OUTPUT
  1.  ;0=ok, 1=no response at all, 2=failure in middle of receive
  1.  ;3=remote system disconnected
  1.  ;   Note: the check for remote system disconnect is based on a string
  1.  ;   match from utility routine %INET. If that utility is changed, this
  1.  ;   must also be changed.
  1.  ;
  1.  N NULLREAD,NORESP,RTO,AP,APDONE,API,APREC,X,REM,INSMIN,REC,INERRREC,INSOM,INEOM,INMS,INREC
  1.  S RTO=INIP("RTO"),INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
  1.  ;Set defaults
  1.  S INSOM=INIP("SOM"),INEOM=INIP("EOM")
  1.  ;;Following must change for X12
  1.  S INDELIM=$$FIELD^INHUT()
  1.  D:$G(INDEBUG) LOG^INHVCRA1("Receiving from socket.",5)
  1.  ; load socket input into INREC (or into ^UTILITY("INREC")
  1.  S (APDONE,APREC,AP)="",(NULLREAD,NORESP)=0,INREC="REC"
  1.  K @INREC
  1.  F  D  Q:APDONE!NORESP
  1.  .D RECV^%INET(.APREC,.INCHNL,RTO,1)
  1.  .I 'AP,$L(APREC),INIP("NOSOM"),APREC'[INSOM S AP=1    ;S APREC=INSOM_APREC ;FOR APCOTS NAKS
  1.  .;check for remote disconnect
  1.  .I $G(APREC(0))["Remote end disconnect" S APDONE=3 Q
  1.  .;Check for SOM at start of message.
  1.  .I 'AP,$L(APREC),APREC'[INSOM D
  1.  ..S INERRREC=$$CLEAN(APREC),APREC=""
  1.  ..S INMS="Data Fragmentation error, no SOM. Ignored: "_$E(INERRREC,1,196)
  1.  ..D ENR^INHE(INBPN,INMS) D:$G(INDEBUG) LOG^INHVCRA1(INMS,3)
  1.  .;Check for multiple SOM's after 1st msg (socket read).
  1.  .I AP,APREC[INSOM D
  1.  ..N X S X=$L(APREC,INSOM),AP=AP+1,@INREC@(AP)=$$CLEAN($P(APREC,INSOM,1,X-1))
  1.  ..S APREC=INSOM_$P(APREC,INSOM,X)
  1.  ..K INMS S INMS(1)="Data Fragmentation error, Multiple SOMs. Ignored: "
  1.  ..S INMS(2)=APREC
  1.  ..D ENR^INHE(INBPN,.INMS) D:$G(INDEBUG) LOG^INHVCRA1(.INMS,3)
  1.  ..K @INREC,INMS S AP=0
  1.  .;Check for multiple SOM's in 1st msg.
  1.  .I 'AP,$L(APREC,INSOM)>2 D
  1.  ..N X S X=$L(APREC,INSOM)
  1.  ..S INERRREC=$$CLEAN($P(APREC,INSOM,1,X-1)),APREC=INSOM_$P(APREC,INSOM,X)
  1.  ..S INMS="Data Fragmentation error, mult SOM.  Ignored: "_$E(INERRREC,1,196)
  1.  ..D ENR^INHE(INBPN,INMS) D:$G(INDEBUG) LOG^INHVCRA1(INMS,3)
  1.  .;Use AP as flag, not a true counter.
  1.  .I 'AP,APREC[INSOM S AP=1 D:$E(APREC)'=INSOM  ;
  1.  ..S INERRREC=$$CLEAN($P(APREC,INSOM)),APREC=INSOM_$P(APREC,INSOM,2)
  1.  ..S INMS="Data Fragmentation error, data before SOM.  Ignored: "_$E(INERRREC,1,196)
  1.  ..D ENR^INHE(INBPN,INMS) D:$G(INDEBUG) LOG^INHVCRA1(INMS,3)
  1.  .;Check for data after EOM
  1.  .I APREC[INEOM D
  1.  ..S INERRREC=$P(APREC,INEOM,2,$L(APREC,INEOM)),APREC=$P(APREC,INEOM)_INEOM
  1.  ..Q:(INERRREC=INIP("EOL"))!'$L(INERRREC)  S INERRREC=$$CLEAN(INERRREC)
  1.  ..S INMS="Data Fragmentation error, data past EOM.  Ignored string: "_$E(INERRREC,1,196)
  1.  ..D ENR^INHE(INBPN,INMS) D:$G(INDEBUG) LOG^INHVCRA1(INMS,3)
  1.  .I APREC=""!(APREC[INEOM) S APDONE=1
  1.  .;Remove message framing characters from packet
  1.  .S APREC=$TR(APREC,INSOM_INEOM)
  1.  .;Check for no response from remote system after NNN tries
  1.  .I '$L(APREC) D  Q
  1.  ..D WAIT^INHUVUT2(INBPN,INIP("RHNG"),"Reading socket",.NORESP) Q:NORESP
  1.  ..S NULLREAD=NULLREAD+1 S:NULLREAD>INIP("RTRY") NORESP=1
  1.  .;If encryption is on, call decryption
  1.  .I $G(INIP("CRYPT")) D
  1.  ..D DECRYPT^INCRYPT(APREC,.X,$L(APREC),$S(AP=1:1,1:0),$S(APDONE:1,1:0))
  1.  ..S APREC=X
  1.  .I $S<INSMIN D
  1.  ..Q:INREC["^"
  1.  ..K ^UTILITY("INREC",$J)
  1.  ..M ^UTILITY("INREC",$J)=@INREC K @INREC S INREC="^UTILITY(""INREC"","_$J_")"
  1.  .S AP=AP+1,@INREC@(AP)=APREC
  1.  ;If remote end disconnected
  1.  I APDONE=3 S INERR=$G(APREC(0)) Q APDONE
  1.  ;If No message was received
  1.  I 'AP S INERR="No message received from remote system on receiver "_$P($G(^INTHPC(INBPN,0)),U) Q 1
  1.  ;If remote system timed-out log error
  1.  I NORESP S INERR="Remote system on "_$P($G(^INTHPC(INBPN,0)),U)_" timed out during transmission of message "_$P($G(@INREC@(1)),$G(INDELIM),10) Q 2
  1.  D PARSE^INHUVUT1
  1.  K @INREC
  1.  Q 0
  1.  ;
  1. PARSE ;Parse INREC array (raw message) into ING array (HL7 segments).
  1.  ;PARSE tag moved to INHUVUT1 because routine size is too large
  1.  D PARSE^INHUVUT1 Q
  1.  ;
  1. INIT(INBPN,INIP) ; Intialize parameters
  1.  D INIT^INHUVUT1(INBPN,.INIP)
  1.  Q
  1.  ;
  1. ASCII(X) ;Converts a string into an ASCII string
  1.  Q $$ASCII^INHUVUT1(X)
  1.  ;
  1. ADDR(INBPN,INIPADIE,INERR) ;Get next IP address from Background Proc file
  1.  Q $$ADDR^INHUVUT2(.INBPN,.INIPADIE,.INERR)
  1.  ;
  1. CPORT(INBPN,INIPADIE,INIPPOIE) ;Get next client port from Background Proc. file
  1.  Q $$CPORT^INHUVUT2(.INBPN,.INIPADIE,.INIPPOIE)
  1.  ;
  1. SPORT(INBPN,INIPADIE,INERR) ;Get next server port from Background Prc. file
  1.  Q $$SPORT^INHUVUT2(.INBPN,.INIPADIE,.INERR)
  1.  ;
  1. WAIT(INBPN,HNG,STAT,STOP) ;Hang function which periodically checks ^INRHB
  1.  D WAIT^INHUVUT2(.INBPN,.HNG,.STAT,.STOP) ; Called by INHV*
  1.  Q
  1. CLEAN(X) ; Clean out control characters
  1.  N I,Y S Y=""
  1.  F I=1:1:$L(X) D  Q:$L(Y)>234
  1.  .I $A(X,I)<32!($A(X,I)>127) S Y=Y_"["_$A(X,I)_"]" Q
  1.  .S Y=Y_$E(X,I)
  1.  Q Y
  1. DB() ;
  1.  Q 0