VBECRL ;HOIFO/BNT - VBECS VistALink Client RawLink Methods ;07/27/2002 13:00
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Call to $$XMLHDR^XOBVLIB Supported by IA 4090
; Call to %ZISTCP is supported by IA: 10104
; Call to %ZISUTL is supported by IA: 2119
; Call to ^%ZOSF is supported by IA: 10096
;
QUIT
;
; ------------------------------------------------------------------------------------
; Methods for Read fromto TCP/IP Socket
; ------------------------------------------------------------------------------------
READ(VBECROOT,VBECREAD,VBECTO,VBECFRST,VBECSTOP) ;
NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,VBECCNT,VBECLEN,VBECBH,VBECEH,BS,ES,VBECOK,VBECX
;
SET STR="",EOT=$C(4),DONE=0,LINE=0,VBECOK=1
;
; -- READ tcp stream to global buffer | main calling tags are EXECUTE^VBECVLC and NXTCALL^VBECVLL
FOR READ VBECX#VBECREAD:VBECTO SET TOFLAG=$T DO:VBECFRST CHK DO:'VBECSTOP QUIT:DONE
. ;
. ; -- if length of (new intake + current) is too large for buffer then store current
. ;IF $L(STR)+$L(VBECX)>400 DO ADD(STR) S STR=""
. F Q:$L(STR)+$L(VBECX)<512 D Q:$L(STR)+$L(VBECX)<512
. . I $L(STR),STR'[">" D ADD($E(STR,1,512)) S STR=$E(STR,513,99999) Q
. . S VBECK1=$F(STR,">") D ADD($E(STR,1,(VBECK1-1))) S STR=$E(STR,VBECK1,99999)
. SET STR=STR_VBECX
. ;
. ; -- add node at each line-feed character
. FOR QUIT:STR'[$C(10) DO ADD($P(STR,$C(10))) SET STR=$P(STR,$C(10),2,999)
. ;
. ; -- if end-of-text marker found then wrap up and quit
. IF STR[EOT SET STR=$P(STR,EOT) DO ADD(STR) SET DONE=1 QUIT
. ;
. ; -- M XML parser cannot handle an element or attribute
. ; -- name split across nodes
. SET PIECES=$L(STR,">")
. ;IF PIECES>1 DO ADD($P(STR,">",1,PIECES-1)_">") SET STR=$P(STR,">",PIECES,999)
. I PIECES>1 D
. . S VBECK1=$F(STR,">") D ADD($E(STR,1,(VBECK1-1)))
. . S STR=$E(STR,VBECK1,99999)
;
QUIT VBECOK
;
ADD(TXT) ; -- add new intake line
SET LINE=LINE+1
SET @VBECROOT@(LINE)=TXT
QUIT
;
CHK ; -- check if first read and change timeout and chars to read
IF 'TOFLAG,VBECFRST,$GET(VBECX)="" SET VBECSTOP=1,DONE=1 QUIT
SET VBECFRST=0
SET VBECREAD=100,VBECTO=1
QUIT
;
; ------------------------------------------------------------------------------------
; Methods for Openning and Closing Socket
; ------------------------------------------------------------------------------------
OPEN(VBECPRMS) ; -- Open tcp/ip socket
NEW I,POP
SET POP=1
DO INIT
;
DO SAVDEV^%ZISUTL("VBECS CLIENT")
FOR I=1:1:VBECPRMS("RETRIES") DO CALL^%ZISTCP(VBECPRMS("ADDRESS"),VBECPRMS("PORT")) QUIT:'POP
; Device open
IF 'POP USE IO QUIT 1
; Device not open
QUIT 'POP
;
CLOSE(VBECPRMS) ; -- close tcp/ip socket
; -- tell server to Stop() connection if close message is needed to close
IF $GET(VBECPRMS("CLOSE MESSAGE"))]"" DO
. DO PRE
. DO WRITE($$XMLHDR^XOBVLIB()_VBECPRMS("CLOSE MESSAGE"))
. DO POST
;
DO FINAL
DO CLOSE^%ZISTCP
DO USE^%ZISUTL("VBECS CLIENT")
DO RMDEV^%ZISUTL("VBECS CLIENT")
QUIT
;
INIT ; -- set up variables needed in tcp/ip processing
SET VBECOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["OpenM":"OpenM",1:"MSM")
QUIT
;
FINAL ; -- kill variables used in tcp/ip processing
KILL VBECOS
QUIT
;
; ------------------------------------------------------------------------------------
; Methods for Writing to TCP/IP Socket
; ------------------------------------------------------------------------------------
PRE ; -- prepare socket for writing
SET $X=0
QUIT
;
WRITE(STR) ; -- Write a data string to socket
IF VBECOS="MSM" WRITE STR QUIT
WRITE:($X+$L(STR))>511 !
WRITE STR
QUIT
;
POST ; -- send eot and flush socket buffer
DO WRITE($C(4))
WRITE:$X>0 !
QUIT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECRL 4097 printed Nov 22, 2024@17:54:19 Page 2
VBECRL ;HOIFO/BNT - VBECS VistALink Client RawLink Methods ;07/27/2002 13:00
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Call to $$XMLHDR^XOBVLIB Supported by IA 4090
+9 ; Call to %ZISTCP is supported by IA: 10104
+10 ; Call to %ZISUTL is supported by IA: 2119
+11 ; Call to ^%ZOSF is supported by IA: 10096
+12 ;
+13 QUIT
+14 ;
+15 ; ------------------------------------------------------------------------------------
+16 ; Methods for Read fromto TCP/IP Socket
+17 ; ------------------------------------------------------------------------------------
READ(VBECROOT,VBECREAD,VBECTO,VBECFRST,VBECSTOP) ;
+1 NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,VBECCNT,VBECLEN,VBECBH,VBECEH,BS,ES,VBECOK,VBECX
+2 ;
+3 SET STR=""
SET EOT=$CHAR(4)
SET DONE=0
SET LINE=0
SET VBECOK=1
+4 ;
+5 ; -- READ tcp stream to global buffer | main calling tags are EXECUTE^VBECVLC and NXTCALL^VBECVLL
+6 FOR
READ VBECX#VBECREAD:VBECTO
SET TOFLAG=$TEST
if VBECFRST
DO CHK
if 'VBECSTOP
Begin DoDot:1
+7 ;
+8 ; -- if length of (new intake + current) is too large for buffer then store current
+9 ;IF $L(STR)+$L(VBECX)>400 DO ADD(STR) S STR=""
+10 FOR
if $LENGTH(STR)+$LENGTH(VBECX)<512
QUIT
Begin DoDot:2
+11 IF $LENGTH(STR)
IF STR'[">"
DO ADD($EXTRACT(STR,1,512))
SET STR=$EXTRACT(STR,513,99999)
QUIT
+12 SET VBECK1=$FIND(STR,">")
DO ADD($EXTRACT(STR,1,(VBECK1-1)))
SET STR=$EXTRACT(STR,VBECK1,99999)
End DoDot:2
if $LENGTH(STR)+$LENGTH(VBECX)<512
QUIT
+13 SET STR=STR_VBECX
+14 ;
+15 ; -- add node at each line-feed character
+16 FOR
if STR'[$CHAR(10)
QUIT
DO ADD($PIECE(STR,$CHAR(10)))
SET STR=$PIECE(STR,$CHAR(10),2,999)
+17 ;
+18 ; -- if end-of-text marker found then wrap up and quit
+19 IF STR[EOT
SET STR=$PIECE(STR,EOT)
DO ADD(STR)
SET DONE=1
QUIT
+20 ;
+21 ; -- M XML parser cannot handle an element or attribute
+22 ; -- name split across nodes
+23 SET PIECES=$LENGTH(STR,">")
+24 ;IF PIECES>1 DO ADD($P(STR,">",1,PIECES-1)_">") SET STR=$P(STR,">",PIECES,999)
+25 IF PIECES>1
Begin DoDot:2
+26 SET VBECK1=$FIND(STR,">")
DO ADD($EXTRACT(STR,1,(VBECK1-1)))
+27 SET STR=$EXTRACT(STR,VBECK1,99999)
End DoDot:2
End DoDot:1
if DONE
QUIT
+28 ;
+29 QUIT VBECOK
+30 ;
ADD(TXT) ; -- add new intake line
+1 SET LINE=LINE+1
+2 SET @VBECROOT@(LINE)=TXT
+3 QUIT
+4 ;
CHK ; -- check if first read and change timeout and chars to read
+1 IF 'TOFLAG
IF VBECFRST
IF $GET(VBECX)=""
SET VBECSTOP=1
SET DONE=1
QUIT
+2 SET VBECFRST=0
+3 SET VBECREAD=100
SET VBECTO=1
+4 QUIT
+5 ;
+6 ; ------------------------------------------------------------------------------------
+7 ; Methods for Openning and Closing Socket
+8 ; ------------------------------------------------------------------------------------
OPEN(VBECPRMS) ; -- Open tcp/ip socket
+1 NEW I,POP
+2 SET POP=1
+3 DO INIT
+4 ;
+5 DO SAVDEV^%ZISUTL("VBECS CLIENT")
+6 FOR I=1:1:VBECPRMS("RETRIES")
DO CALL^%ZISTCP(VBECPRMS("ADDRESS"),VBECPRMS("PORT"))
if 'POP
QUIT
+7 ; Device open
+8 IF 'POP
USE IO
QUIT 1
+9 ; Device not open
+10 QUIT 'POP
+11 ;
CLOSE(VBECPRMS) ; -- close tcp/ip socket
+1 ; -- tell server to Stop() connection if close message is needed to close
+2 IF $GET(VBECPRMS("CLOSE MESSAGE"))]""
Begin DoDot:1
+3 DO PRE
+4 DO WRITE($$XMLHDR^XOBVLIB()_VBECPRMS("CLOSE MESSAGE"))
+5 DO POST
End DoDot:1
+6 ;
+7 DO FINAL
+8 DO CLOSE^%ZISTCP
+9 DO USE^%ZISUTL("VBECS CLIENT")
+10 DO RMDEV^%ZISUTL("VBECS CLIENT")
+11 QUIT
+12 ;
INIT ; -- set up variables needed in tcp/ip processing
+1 SET VBECOS=$SELECT(^%ZOSF("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["OpenM":"OpenM",1:"MSM")
+2 QUIT
+3 ;
FINAL ; -- kill variables used in tcp/ip processing
+1 KILL VBECOS
+2 QUIT
+3 ;
+4 ; ------------------------------------------------------------------------------------
+5 ; Methods for Writing to TCP/IP Socket
+6 ; ------------------------------------------------------------------------------------
PRE ; -- prepare socket for writing
+1 SET $X=0
+2 QUIT
+3 ;
WRITE(STR) ; -- Write a data string to socket
+1 IF VBECOS="MSM"
WRITE STR
QUIT
+2 if ($X+$LENGTH(STR))>511
WRITE !
+3 WRITE STR
+4 QUIT
+5 ;
POST ; -- send eot and flush socket buffer
+1 DO WRITE($CHAR(4))
+2 if $X>0
WRITE !
+3 QUIT
+4 ;
