INHVTMT1 ; DGH,FRW,CHEM,WAB,KAC ; 06 Aug 1999 15:34:58; Multi-threaded TCP/IP socket utilities
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
Q
;
SEND(INUIF,INIPPO,INIP) ; Function - Send msg from ^INTHU to a socket
; 1) includes INIP variables for message framing.
; 2) encrypts outgoing messages if the encryption flag is on.
;
; Called by: INHVTMT
;
;Input:
; INIPPO - (req) Socket
; INIP("SOM") - (opt) Start of msg
; INIP("EOL") - (opt) End of line (end of segment)
; INIP("EOM") - (opt) End of msg
; INIP("CRYPT") - (opt) Encryption flag
; INIP("DESKEY") - (opt) DES key
;
;Output:
; 0 - successful
; 1 - error
;
N LCT,LINE,I,INBUF,INB,INCRYPT,INDELIM,INLAST,INMAX,INSL,INSMIN
S INDELIM=$$FIELD^INHUT(),INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
; Set maximum string length dependent upon whether encryption is on
S INMAX=$S('INIP("CRYPT"):508,1:328),INBUF="",INB="INB"
; Write message
S LCT=0 F D GETLINE^INHOU(INUIF,.LCT,.LINE) Q:'$D(LINE) D
. I LCT=1 D SAVE(INIP("SOM")_$TR($$NOCTRL^INHUTIL(LINE),INDELIM,INIP("FS"))_INIP("SOD")) Q
. ;remove control characters if they exist
. S LINE=$TR($$NOCTRL^INHUTIL(LINE),INDELIM,INIP("FS"))
. D SAVE(LINE)
. ;Copy overflow nodes (if any)
. F I=1:1 Q:'$D(LINE(I)) D
.. ;remove control characters if they exist
.. S LINE(I)=$TR($$NOCTRL^INHUTIL(LINE(I)),INDELIM,INIP("FS"))
.. D SAVE(LINE(I))
. ;
. ;Add segment terminator to this line if not last line
. S INLAST=$S($D(^INTHU(INUIF,3,LCT+1,0)):0,1:1)
. I 'INLAST D SAVE(INIP("EOL"))
;
; send what's in buffer and quit
D SAVE(INIP("EOM"),1)
D:$G(INDEBUG) LOG^INHVCRA1("Message "_$G(INUIF)_" sent.",5)
Q 0
;
SAVE(INSTR,INLST) ; save msg to buffer
; INSTR = (req) string to save
; INLST = (opt) if TRUE, means end of msg, time to transmit
; this assumes that INSTR is the EOM chars
; and adds them after the body
;
I $G(INLST) D Q
. N INDLEN,X1,X2,L,MX
. I $L(INBUF) S INSL=INSL+1,@INB@(INSL)=INBUF
. F I=2:1:INSL D
.. ; encrypt if needed
.. I INIP("CRYPT") D
... S X1=@INB@(I)
... D ENCRYPT^INCRYPT(.X1,.X2,$L(X1),I=2,I=INSL)
... S @INB@(I)=X2
.. ; count data length
.. S INDLEN=$G(INDLEN)+$L(@INB@(I))
. ; add EOM chars
. S INSL=INSL+1,@INB@(INSL)=INSTR
. ; set data length in header here
. S $E(@INB@(1),24,27)=$TR($J($G(INDLEN),4)," ","0")
. ; pack lines into 512 strings for transmit
. S INBUF="",MX=512 F I=1:1:INSL D
.. S X=@INB@(I),L=MX-$L(INBUF)
.. S INBUF=INBUF_$E(X,1,L),X=$E(X,L,$L(X))
.. I $L(INBUF)=MX D SEND^%INET(INBUF,INIPPO,1) S INBUF=X
. ; send remainder
. I $L(INBUF) D SEND^%INET(INBUF,INIPPO,1)
. ; clean up the send buffer
. K @INB,INSL
;
; if line = 1 save
I '$G(INSL) S INSL=1,@INB@(INSL)=INSTR Q
; pack for encription
S X=$$PACK^INCRYP(INSTR,INMAX,.INBUF)
Q:'$L(X)
; switch to global storage if short on memory
I $E(INB)'="^",$S<INSMIN K ^UTILITY("INB",$J) M ^($J)=@INB K @INB S INB="^UTILITY(""INB"","_$J_")"
; inc line & save
S INSL=$G(INSL)+1,@INB@(INSL)=X
Q
;
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
+2 ;COPYRIGHT 1991-2000 SAIC
+3 QUIT
+4 ;
SEND(INUIF,INIPPO,INIP) ; Function - Send msg from ^INTHU to a socket
+1 ; 1) includes INIP variables for message framing.
+2 ; 2) encrypts outgoing messages if the encryption flag is on.
+3 ;
+4 ; Called by: INHVTMT
+5 ;
+6 ;Input:
+7 ; INIPPO - (req) Socket
+8 ; INIP("SOM") - (opt) Start of msg
+9 ; INIP("EOL") - (opt) End of line (end of segment)
+10 ; INIP("EOM") - (opt) End of msg
+11 ; INIP("CRYPT") - (opt) Encryption flag
+12 ; INIP("DESKEY") - (opt) DES key
+13 ;
+14 ;Output:
+15 ; 0 - successful
+16 ; 1 - error
+17 ;
+18 NEW LCT,LINE,I,INBUF,INB,INCRYPT,INDELIM,INLAST,INMAX,INSL,INSMIN
+19 SET INDELIM=$$FIELD^INHUT()
SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
+20 ; Set maximum string length dependent upon whether encryption is on
+21 SET INMAX=$SELECT('INIP("CRYPT"):508,1:328)
SET INBUF=""
SET INB="INB"
+22 ; Write message
+23 SET LCT=0
FOR
DO GETLINE^INHOU(INUIF,.LCT,.LINE)
IF '$DATA(LINE)
QUIT
Begin DoDot:1
+24 IF LCT=1
DO SAVE(INIP("SOM")_$TRANSLATE($$NOCTRL^INHUTIL(LINE),INDELIM,INIP("FS"))_INIP("SOD"))
QUIT
+25 ;remove control characters if they exist
+26 SET LINE=$TRANSLATE($$NOCTRL^INHUTIL(LINE),INDELIM,INIP("FS"))
+27 DO SAVE(LINE)
+28 ;Copy overflow nodes (if any)
+29 FOR I=1:1
IF '$DATA(LINE(I))
QUIT
Begin DoDot:2
+30 ;remove control characters if they exist
+31 SET LINE(I)=$TRANSLATE($$NOCTRL^INHUTIL(LINE(I)),INDELIM,INIP("FS"))
+32 DO SAVE(LINE(I))
End DoDot:2
+33 ;
+34 ;Add segment terminator to this line if not last line
+35 SET INLAST=$SELECT($DATA(^INTHU(INUIF,3,LCT+1,0)):0,1:1)
+36 IF 'INLAST
DO SAVE(INIP("EOL"))
End DoDot:1
+37 ;
+38 ; send what's in buffer and quit
+39 DO SAVE(INIP("EOM"),1)
+40 IF $GET(INDEBUG)
DO LOG^INHVCRA1("Message "_$GET(INUIF)_" sent.",5)
+41 QUIT 0
+42 ;
SAVE(INSTR,INLST) ; save msg to buffer
+1 ; INSTR = (req) string to save
+2 ; INLST = (opt) if TRUE, means end of msg, time to transmit
+3 ; this assumes that INSTR is the EOM chars
+4 ; and adds them after the body
+5 ;
+6 IF $GET(INLST)
Begin DoDot:1
+7 NEW INDLEN,X1,X2,L,MX
+8 IF $LENGTH(INBUF)
SET INSL=INSL+1
SET @INB@(INSL)=INBUF
+9 FOR I=2:1:INSL
Begin DoDot:2
+10 ; encrypt if needed
+11 IF INIP("CRYPT")
Begin DoDot:3
+12 SET X1=@INB@(I)
+13 DO ENCRYPT^INCRYPT(.X1,.X2,$LENGTH(X1),I=2,I=INSL)
+14 SET @INB@(I)=X2
End DoDot:3
+15 ; count data length
+16 SET INDLEN=$GET(INDLEN)+$LENGTH(@INB@(I))
End DoDot:2
+17 ; add EOM chars
+18 SET INSL=INSL+1
SET @INB@(INSL)=INSTR
+19 ; set data length in header here
+20 SET $EXTRACT(@INB@(1),24,27)=$TRANSLATE($JUSTIFY($GET(INDLEN),4)," ","0")
+21 ; pack lines into 512 strings for transmit
+22 SET INBUF=""
SET MX=512
FOR I=1:1:INSL
Begin DoDot:2
+23 SET X=@INB@(I)
SET L=MX-$LENGTH(INBUF)
+24 SET INBUF=INBUF_$EXTRACT(X,1,L)
SET X=$EXTRACT(X,L,$LENGTH(X))
+25 IF $LENGTH(INBUF)=MX
DO SEND^%INET(INBUF,INIPPO,1)
SET INBUF=X
End DoDot:2
+26 ; send remainder
+27 IF $LENGTH(INBUF)
DO SEND^%INET(INBUF,INIPPO,1)
+28 ; clean up the send buffer
+29 KILL @INB,INSL
End DoDot:1
QUIT
+30 ;
+31 ; if line = 1 save
+32 IF '$GET(INSL)
SET INSL=1
SET @INB@(INSL)=INSTR
QUIT
+33 ; pack for encription
+34 SET X=$$PACK^INCRYP(INSTR,INMAX,.INBUF)
+35 IF '$LENGTH(X)
QUIT
+36 ; switch to global storage if short on memory
+37 IF $EXTRACT(INB)'="^"
IF $STORAGE<INSMIN
KILL ^UTILITY("INB",$JOB)
MERGE ^($JOB)=@INB
KILL @INB
SET INB="^UTILITY(""INB"","_$JOB_")"
+38 ; inc line & save
+39 SET INSL=$GET(INSL)+1
SET @INB@(INSL)=X
+40 QUIT
+41 ;
