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

INHVTMT1.m

Go to the documentation of this file.
  1. INHVTMT1 ; DGH,FRW,CHEM,WAB,KAC ; 06 Aug 1999 15:34:58; Multi-threaded TCP/IP socket utilities
  1. ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1. ;COPYRIGHT 1991-2000 SAIC
  1. Q
  1. ;
  1. SEND(INUIF,INIPPO,INIP) ; Function - Send msg from ^INTHU to a socket
  1. ; 1) includes INIP variables for message framing.
  1. ; 2) encrypts outgoing messages if the encryption flag is on.
  1. ;
  1. ; Called by: INHVTMT
  1. ;
  1. ;Input:
  1. ; INIPPO - (req) Socket
  1. ; INIP("SOM") - (opt) Start of msg
  1. ; INIP("EOL") - (opt) End of line (end of segment)
  1. ; INIP("EOM") - (opt) End of msg
  1. ; INIP("CRYPT") - (opt) Encryption flag
  1. ; INIP("DESKEY") - (opt) DES key
  1. ;
  1. ;Output:
  1. ; 0 - successful
  1. ; 1 - error
  1. ;
  1. N LCT,LINE,I,INBUF,INB,INCRYPT,INDELIM,INLAST,INMAX,INSL,INSMIN
  1. S INDELIM=$$FIELD^INHUT(),INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
  1. ; Set maximum string length dependent upon whether encryption is on
  1. S INMAX=$S('INIP("CRYPT"):508,1:328),INBUF="",INB="INB"
  1. ; Write message
  1. S LCT=0 F D GETLINE^INHOU(INUIF,.LCT,.LINE) Q:'$D(LINE) D
  1. . I LCT=1 D SAVE(INIP("SOM")_$TR($$NOCTRL^INHUTIL(LINE),INDELIM,INIP("FS"))_INIP("SOD")) Q
  1. . ;remove control characters if they exist
  1. . S LINE=$TR($$NOCTRL^INHUTIL(LINE),INDELIM,INIP("FS"))
  1. . D SAVE(LINE)
  1. . ;Copy overflow nodes (if any)
  1. . F I=1:1 Q:'$D(LINE(I)) D
  1. .. ;remove control characters if they exist
  1. .. S LINE(I)=$TR($$NOCTRL^INHUTIL(LINE(I)),INDELIM,INIP("FS"))
  1. .. D SAVE(LINE(I))
  1. . ;
  1. . ;Add segment terminator to this line if not last line
  1. . S INLAST=$S($D(^INTHU(INUIF,3,LCT+1,0)):0,1:1)
  1. . I 'INLAST D SAVE(INIP("EOL"))
  1. ;
  1. ; send what's in buffer and quit
  1. D SAVE(INIP("EOM"),1)
  1. D:$G(INDEBUG) LOG^INHVCRA1("Message "_$G(INUIF)_" sent.",5)
  1. Q 0
  1. ;
  1. SAVE(INSTR,INLST) ; save msg to buffer
  1. ; INSTR = (req) string to save
  1. ; INLST = (opt) if TRUE, means end of msg, time to transmit
  1. ; this assumes that INSTR is the EOM chars
  1. ; and adds them after the body
  1. ;
  1. I $G(INLST) D Q
  1. . N INDLEN,X1,X2,L,MX
  1. . I $L(INBUF) S INSL=INSL+1,@INB@(INSL)=INBUF
  1. . F I=2:1:INSL D
  1. .. ; encrypt if needed
  1. .. I INIP("CRYPT") D
  1. ... S X1=@INB@(I)
  1. ... D ENCRYPT^INCRYPT(.X1,.X2,$L(X1),I=2,I=INSL)
  1. ... S @INB@(I)=X2
  1. .. ; count data length
  1. .. S INDLEN=$G(INDLEN)+$L(@INB@(I))
  1. . ; add EOM chars
  1. . S INSL=INSL+1,@INB@(INSL)=INSTR
  1. . ; set data length in header here
  1. . S $E(@INB@(1),24,27)=$TR($J($G(INDLEN),4)," ","0")
  1. . ; pack lines into 512 strings for transmit
  1. . S INBUF="",MX=512 F I=1:1:INSL D
  1. .. S X=@INB@(I),L=MX-$L(INBUF)
  1. .. S INBUF=INBUF_$E(X,1,L),X=$E(X,L,$L(X))
  1. .. I $L(INBUF)=MX D SEND^%INET(INBUF,INIPPO,1) S INBUF=X
  1. . ; send remainder
  1. . I $L(INBUF) D SEND^%INET(INBUF,INIPPO,1)
  1. . ; clean up the send buffer
  1. . K @INB,INSL
  1. ;
  1. ; if line = 1 save
  1. I '$G(INSL) S INSL=1,@INB@(INSL)=INSTR Q
  1. ; pack for encription
  1. S X=$$PACK^INCRYP(INSTR,INMAX,.INBUF)
  1. Q:'$L(X)
  1. ; switch to global storage if short on memory
  1. I $E(INB)'="^",$S<INSMIN K ^UTILITY("INB",$J) M ^($J)=@INB K @INB S INB="^UTILITY(""INB"","_$J_")"
  1. ; inc line & save
  1. S INSL=$G(INSL)+1,@INB@(INSL)=X
  1. Q
  1. ;