XOBVSKT.m

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       ;