XOBVSKT ;; mjk/alb - VistaLink Socket Methods ; 07/27/2002 13:00
;;1.5;VistALink;;Sep 09, 2005
;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
;
QUIT
;
; ------------------------------------------------------------------------------------
; Methods for Read fromto TCP/IP Socket
; ------------------------------------------------------------------------------------
READ(XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBSTOP,XOBDATA,XOBHDLR) ;
NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,XOBCNT,XOBLEN,XOBBH,XOBEH,BS,ES,XOBOK,XOBX
;
SET STR="",EOT=$CHAR(4),DONE=0,LINE=0,XOBOK=1
;
; -- READ tcp stream to global buffer | main calling tag NXTCALL^XOBVLL
FOR READ XOBX#XOBREAD:XOBTO SET TOFLAG=$TEST DO:XOBFIRST CHK DO:'XOBSTOP!('DONE) QUIT:DONE
. ;
. ; -- if length of (new intake + current) is too large for buffer then store current
. IF $LENGTH(STR)+$LENGTH(XOBX)>400 DO ADD(STR) SET STR=""
. SET STR=STR_XOBX
. ;
. ; -- add node at each line-feed character
. ; COMMENTED OUT: Not needed anymore, and has side effect of stripping out line feeds in input
. ; array-type parameter values (in XML mode)
. ; FOR QUIT:STR'[$CHAR(10) DO ADD($PIECE(STR,$CHAR(10))) SET STR=$PIECE(STR,$CHAR(10),2,999)
. ;
. ; -- if end-of-text marker found then wrap up and quit
. IF STR[EOT SET STR=$PIECE(STR,EOT) DO ADD(STR) SET DONE=1 QUIT
. ;
. ; -- M XML parser cannot handle an element name split across nodes
. SET PIECES=$LENGTH(STR,">")
. IF PIECES>1 DO ADD($PIECE(STR,">",1,PIECES-1)_">") SET STR=$PIECE(STR,">",PIECES,999)
;
QUIT XOBOK
;
ADD(TXT) ; -- add new intake line
SET LINE=LINE+1
SET @XOBROOT@(LINE)=TXT
QUIT
;
CHK ; -- check if first read and change timeout and chars to read
SET XOBFIRST=0
;
; -- abort if time out occurred and nothing was read
IF 'TOFLAG,$GET(XOBX)="" SET XOBSTOP=1,DONE=1,XOBOK=0 QUIT
;
; -- intercept for transport sinks
IF $EXTRACT(XOBX)'="<" DO SINK
;
; -- set up for subsequent reads
SET XOBREAD=200,XOBTO=1
QUIT
;
; ------------------------------------------------------------------------------------
; Execute Proprietary Format Reader
; ------------------------------------------------------------------------------------
SINK ;
; -- get size of sink indicator >> then get sink indicator >> load req handler
SET XOBHDLR=$$MSGSINK^XOBVRH($$GETSTR(+$$GETSTR(2,.XOBX),.XOBX),.XOBHDLR)
;
; -- execute proprietary stream reader
IF $GET(XOBHDLR(XOBHDLR)) XECUTE $GET(XOBHDLR(XOBHDLR,"READER"))
;
SET DONE=1
QUIT
;
; -- get string of length LEN from stream buffer
GETSTR(LEN,XOBUF) ;
NEW X
FOR QUIT:($LENGTH(XOBUF)'<LEN) DO RMORE(LEN-$LENGTH(XOBUF),.XOBUF)
SET X=$EXTRACT(XOBUF,1,LEN)
SET XOBUF=$EXTRACT(XOBUF,LEN+1,999)
QUIT X
;
; -- read more from stream buffer but only needed amount
RMORE(LEN,XOBUF) ;
NEW X
READ X#LEN:1 SET XOBUF=XOBUF_X
QUIT
;
; ------------------------------------------------------------------------------------
; Methods for Openning and Closing Socket
; ------------------------------------------------------------------------------------
OPEN(XOBPARMS) ; -- Open tcp/ip socket
NEW I,POP
SET POP=1
;
; -- set up os var
DO OS
;
; -- preserve client io
DO SAVDEV^%ZISUTL("XOB CLIENT")
;
FOR I=1:1:XOBPARMS("RETRIES") DO CALL^%ZISTCP(XOBPARMS("ADDRESS"),XOBPARMS("PORT")) QUIT:'POP
; -- device open
IF 'POP USE IO QUIT 1
; -- device not open
QUIT 0
;
CLOSE(XOBPARMS) ; -- close tcp/ip socket
; -- tell server to Stop() connection if close message is needed to close
IF $GET(XOBPARMS("CLOSE MESSAGE"))]"" DO
. DO PRE
. DO WRITE($$XMLHDR^XOBVLIB()_XOBPARMS("CLOSE MESSAGE"))
. DO POST
;
DO FINAL
DO CLOSE^%ZISTCP
DO USE^%ZISUTL("XOB CLIENT")
DO RMDEV^%ZISUTL("XOB CLIENT")
QUIT
;
INIT ; -- set up variables needed in tcp/ip processing
KILL XOBNULL
;
; -- setup os var
DO OS
;
; -- set RPC Broker os variable (so $$BROKER^XWBLIB returns true)
SET XWBOS=XOBOS
;
; -- setup null device called "NULL"
SET %ZIS="0H",IOP="NULL" DO ^%ZIS
IF 'POP DO
. SET XOBNULL=IO
. DO SAVDEV^%ZISUTL("XOBNULL")
QUIT
;
OS ; -- os var
SET XOBOS=$SELECT(^%ZOSF("OS")["OpenM":"OpenM",^("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["MSM":"MSM",1:"")
QUIT
;
FINAL ; -- kill variables used in tcp/ip processing
;
; -- close null device
IF $DATA(XOBNULL) DO
. DO USE^%ZISUTL("XOBNULL")
. DO CLOSE^%ZISUTL("XOBNULL")
. KILL XOBNULL
;
KILL XOBOS,XWBOS
;
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 XOBOS="MSM" WRITE STR QUIT
;
; -- handle a short string
IF $LENGTH(STR)<511 DO:($X+$LENGTH(STR))>511 FLUSH WRITE STR QUIT
;
; -- handle a long string
DO FLUSH
FOR QUIT:'$LENGTH(STR) WRITE $EXTRACT(STR,1,511) DO FLUSH SET STR=$EXTRACT(STR,512,99999)
;
QUIT
;
POST ; -- send eot and flush socket buffer
DO WRITE($CHAR(4))
DO FLUSH
QUIT
;
FLUSH ; flush buffer
IF XOBOS="OpenM" WRITE ! QUIT
IF XOBOS="DSM" WRITE:$X>0 ! QUIT
;IF XOBOS="GTM" WRITE # QUIT
QUIT
;
XOBVSKT ;; mjk/alb - VistaLink Socket Methods ; 07/27/2002 13:00
+1 ;;1.5;VistALink;;Sep 09, 2005
+2 ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
+3 ;
+4 QUIT
+5 ;
+6 ; ------------------------------------------------------------------------------------
+7 ; Methods for Read fromto TCP/IP Socket
+8 ; ------------------------------------------------------------------------------------
READ(XOBROOT,XOBREAD,XOBTO,XOBFIRST,XOBSTOP,XOBDATA,XOBHDLR) ;
+1 NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,XOBCNT,XOBLEN,XOBBH,XOBEH,BS,ES,XOBOK,XOBX
+2 ;
+3 SET STR=""
SET EOT=$CHAR(4)
SET DONE=0
SET LINE=0
SET XOBOK=1
+4 ;
+5 ; -- READ tcp stream to global buffer | main calling tag NXTCALL^XOBVLL
+6 FOR
READ XOBX#XOBREAD:XOBTO
SET TOFLAG=$TEST
IF XOBFIRST
DO CHK
IF 'XOBSTOP!('DONE)
Begin DoDot:1
+7 ;
+8 ; -- if length of (new intake + current) is too large for buffer then store current
+9 IF $LENGTH(STR)+$LENGTH(XOBX)>400
DO ADD(STR)
SET STR=""
+10 SET STR=STR_XOBX
+11 ;
+12 ; -- add node at each line-feed character
+13 ; COMMENTED OUT: Not needed anymore, and has side effect of stripping out line feeds in input
+14 ; array-type parameter values (in XML mode)
+15 ; FOR QUIT:STR'[$CHAR(10) DO ADD($PIECE(STR,$CHAR(10))) SET STR=$PIECE(STR,$CHAR(10),2,999)
+16 ;
+17 ; -- if end-of-text marker found then wrap up and quit
+18 IF STR[EOT
SET STR=$PIECE(STR,EOT)
DO ADD(STR)
SET DONE=1
QUIT
+19 ;
+20 ; -- M XML parser cannot handle an element name split across nodes
+21 SET PIECES=$LENGTH(STR,">")
+22 IF PIECES>1
DO ADD($PIECE(STR,">",1,PIECES-1)_">")
SET STR=$PIECE(STR,">",PIECES,999)
End DoDot:1
IF DONE
QUIT
+23 ;
+24 QUIT XOBOK
+25 ;
ADD(TXT) ; -- add new intake line
+1 SET LINE=LINE+1
+2 SET @XOBROOT@(LINE)=TXT
+3 QUIT
+4 ;
CHK ; -- check if first read and change timeout and chars to read
+1 SET XOBFIRST=0
+2 ;
+3 ; -- abort if time out occurred and nothing was read
+4 IF 'TOFLAG
IF $GET(XOBX)=""
SET XOBSTOP=1
SET DONE=1
SET XOBOK=0
QUIT
+5 ;
+6 ; -- intercept for transport sinks
+7 IF $EXTRACT(XOBX)'="<"
DO SINK
+8 ;
+9 ; -- set up for subsequent reads
+10 SET XOBREAD=200
SET XOBTO=1
+11 QUIT
+12 ;
+13 ; ------------------------------------------------------------------------------------
+14 ; Execute Proprietary Format Reader
+15 ; ------------------------------------------------------------------------------------
SINK ;
+1 ; -- get size of sink indicator >> then get sink indicator >> load req handler
+2 SET XOBHDLR=$$MSGSINK^XOBVRH($$GETSTR(+$$GETSTR(2,.XOBX),.XOBX),.XOBHDLR)
+3 ;
+4 ; -- execute proprietary stream reader
+5 IF $GET(XOBHDLR(XOBHDLR))
XECUTE $GET(XOBHDLR(XOBHDLR,"READER"))
+6 ;
+7 SET DONE=1
+8 QUIT
+9 ;
+10 ; -- get string of length LEN from stream buffer
GETSTR(LEN,XOBUF) ;
+1 NEW X
+2 FOR
IF ($LENGTH(XOBUF)'<LEN)
QUIT
DO RMORE(LEN-$LENGTH(XOBUF),.XOBUF)
+3 SET X=$EXTRACT(XOBUF,1,LEN)
+4 SET XOBUF=$EXTRACT(XOBUF,LEN+1,999)
+5 QUIT X
+6 ;
+7 ; -- read more from stream buffer but only needed amount
RMORE(LEN,XOBUF) ;
+1 NEW X
+2 READ X#LEN:1
SET XOBUF=XOBUF_X
+3 QUIT
+4 ;
+5 ; ------------------------------------------------------------------------------------
+6 ; Methods for Openning and Closing Socket
+7 ; ------------------------------------------------------------------------------------
OPEN(XOBPARMS) ; -- Open tcp/ip socket
+1 NEW I,POP
+2 SET POP=1
+3 ;
+4 ; -- set up os var
+5 DO OS
+6 ;
+7 ; -- preserve client io
+8 DO SAVDEV^%ZISUTL("XOB CLIENT")
+9 ;
+10 FOR I=1:1:XOBPARMS("RETRIES")
DO CALL^%ZISTCP(XOBPARMS("ADDRESS"),XOBPARMS("PORT"))
IF 'POP
QUIT
+11 ; -- device open
+12 IF 'POP
USE IO
QUIT 1
+13 ; -- device not open
+14 QUIT 0
+15 ;
CLOSE(XOBPARMS) ; -- close tcp/ip socket
+1 ; -- tell server to Stop() connection if close message is needed to close
+2 IF $GET(XOBPARMS("CLOSE MESSAGE"))]""
Begin DoDot:1
+3 DO PRE
+4 DO WRITE($$XMLHDR^XOBVLIB()_XOBPARMS("CLOSE MESSAGE"))
+5 DO POST
End DoDot:1
+6 ;
+7 DO FINAL
+8 DO CLOSE^%ZISTCP
+9 DO USE^%ZISUTL("XOB CLIENT")
+10 DO RMDEV^%ZISUTL("XOB CLIENT")
+11 QUIT
+12 ;
INIT ; -- set up variables needed in tcp/ip processing
+1 KILL XOBNULL
+2 ;
+3 ; -- setup os var
+4 DO OS
+5 ;
+6 ; -- set RPC Broker os variable (so $$BROKER^XWBLIB returns true)
+7 SET XWBOS=XOBOS
+8 ;
+9 ; -- setup null device called "NULL"
+10 SET %ZIS="0H"
SET IOP="NULL"
DO ^%ZIS
+11 IF 'POP
Begin DoDot:1
+12 SET XOBNULL=IO
+13 DO SAVDEV^%ZISUTL("XOBNULL")
End DoDot:1
+14 QUIT
+15 ;
OS ; -- os var
+1 SET XOBOS=$SELECT(^%ZOSF("OS")["OpenM":"OpenM",^("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["MSM":"MSM",1:"")
+2 QUIT
+3 ;
FINAL ; -- kill variables used in tcp/ip processing
+1 ;
+2 ; -- close null device
+3 IF $DATA(XOBNULL)
Begin DoDot:1
+4 DO USE^%ZISUTL("XOBNULL")
+5 DO CLOSE^%ZISUTL("XOBNULL")
+6 KILL XOBNULL
End DoDot:1
+7 ;
+8 KILL XOBOS,XWBOS
+9 ;
+10 QUIT
+11 ;
+12 ; ------------------------------------------------------------------------------------
+13 ; Methods for Writing to TCP/IP Socket
+14 ; ------------------------------------------------------------------------------------
PRE ; -- prepare socket for writing
+1 SET $X=0
+2 QUIT
+3 ;
WRITE(STR) ; -- Write a data string to socket
+1 IF XOBOS="MSM"
WRITE STR
QUIT
+2 ;
+3 ; -- handle a short string
+4 IF $LENGTH(STR)<511
IF ($X+$LENGTH(STR))>511
DO FLUSH
WRITE STR
QUIT
+5 ;
+6 ; -- handle a long string
+7 DO FLUSH
+8 FOR
IF '$LENGTH(STR)
QUIT
WRITE $EXTRACT(STR,1,511)
DO FLUSH
SET STR=$EXTRACT(STR,512,99999)
+9 ;
+10 QUIT
+11 ;
POST ; -- send eot and flush socket buffer
+1 DO WRITE($CHAR(4))
+2 DO FLUSH
+3 QUIT
+4 ;
FLUSH ; flush buffer
+1 IF XOBOS="OpenM"
WRITE !
QUIT
+2 IF XOBOS="DSM"
IF $X>0
WRITE !
QUIT
+3 ;IF XOBOS="GTM" WRITE # QUIT
+4 QUIT
+5 ;
