- 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 ;