XWBRL ;OIFO-Oakland/REM - M2M Link Methods ;05/31/2005 15:13
;;1.1;RPC BROKER;**28,34**;Mar 28, 1997
;
QUIT
;
;p34 -make sure that XWBOS is define - WRITE.
; -modified code to support the new meaning of $X in Cache
; 5.x - WRITE.
; -removed intervening lines that call WBF - WRITE.
; -added code to include option for GTM - WBF.
; -add line for XWBTCPM to read by Wally's non-call back service.
;
; ---------------------------------------------------------------------
; Methods for Read from and to TCP/IP Socket
; ---------------------------------------------------------------------
READ(XWBROOT,XWBREAD,XWBTO,XWBFIRST,XWBSTOP) ;
NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,XWBCNT,XWBLEN
SET STR="",EOT=$C(4),DONE=0,LINE=0
;From XWBTCPM startup, One time thing *p34
I $D(XWBRBUF)=1 S STR=XWBRBUF,XWBTO=0,XWBFIRST=0 K XWBRBUF
;
; -- READ needs work for length checking ; This needs work!!
FOR READ XWBX#XWBREAD:XWBTO SET TOFLAG=$T DO CHK DO:'XWBSTOP QUIT:DONE
. IF $L(STR)+$L(XWBX)>400 DO ADD(STR) S STR=""
. SET STR=STR_XWBX
. FOR Q:STR'[$C(10) DO ADD($P(STR,$C(10))) SET STR=$P(STR,$C(10),2,999)
. IF STR[EOT SET STR=$P(STR,EOT) DO ADD(STR) SET DONE=1 QUIT
. SET PIECES=$L(STR,">")
. IF PIECES>1 DO ADD($P(STR,">",1,PIECES-1)_">") SET STR=$P(STR,">",PIECES,999)
;
QUIT 1
;
ADD(TXT) ; -- add new intake line
SET LINE=LINE+1
SET @XWBROOT@(LINE)=TXT
QUIT
;
CHK ; -- check if first read and change timeout and chars to read
IF 'TOFLAG,XWBFIRST SET XWBSTOP=1,DONE=1 QUIT ; -- could cause small msg to not process
SET XWBFIRST=0
SET XWBREAD=100,XWBTO=2 ;M2M changed XWBTO=2
QUIT
;
;
; ---------------------------------------------------------------------
; Methods for Opening and Closing Socket
; ---------------------------------------------------------------------
OPEN(XWBPARMS) ; -- Open tcp/ip socket
NEW I,POP
SET POP=1
DO INIT
DO SAVDEV^%ZISUTL("XWBM2M CLIENT") ;M2M changed name
FOR I=1:1:XWBPARMS("RETRIES") DO CALL^%ZISTCP(XWBPARMS("ADDRESS"),XWBPARMS("PORT")) QUIT:'POP
; Device open
;
IF 'POP USE IO QUIT 1
; Device not open
QUIT 0
;
CLOSE ; -- close tcp/ip socket
; -- tell server to Stop() connection
I $G(XWBOS)="" D INIT
DO PRE
DO WRITE($$XMLHDR^XWBUTL()_"<vistalink type='Gov.VA.Med.Foundations.CloseSocketRequest' ></vistalink>")
DO POST
;
; -Read results from server close string. **M2M
IF $G(XWBPARMS("CCLOSERESULTS"))="" SET XWBPARMS("CCLOSERESULTS")=$NA(^TMP("XWBM2MRL",$J,"XML"))
SET XWBROOT=XWBPARMS("CCLOSERESULTS") K @XWBROOT
SET XWBREAD=20,XWBTO=1,XWBFIRST=0,XWBSTOP=0
SET XWBCOK=$$READ^XWBRL(XWBROOT,.XWBREAD,.XWBTO,.XWBFIRST,.XWBSTOP)
;
DO FINAL
DO CLOSE^%ZISTCP
DO USE^%ZISUTL("XWBM2M CLIENT") ; Change name **M2M
DO RMDEV^%ZISUTL("XWBM2M CLIENT")
QUIT
;
INIT ; -- set up variables needed in tcp/ip processing
SET XWBOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["OpenM":"OpenM",1:"MSM")
QUIT
;
FINAL ; -- kill variables used in tcp/ip processing
KILL XWBOS,XWBOS,XWBPARMS,XWBPARMS
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
;*p34-removed intervening lines that call WBF.
;
I $G(XWBOS)="" D INIT ;*p34-make sure XWBOS is defined.
IF XWBOS="MSM" WRITE STR QUIT
; send data for DSM (requires buffer flush (!) every 511 chars)
; GT.M is the same as DSM.
; Use an arbitrary value of 255 as the Write limit.
;IF XWBOS="DSM"!(XWBOS="UNIX")!(XWBOS="OpenM) next line
;
;*p34-modified write to for Cache 5 in case less then 255 char.
F Q:'$L(STR) W $E(STR,1,255) D WBF S STR=$E(STR,256,99999)
;
;Old code**
;;I $L(STR)<255 D:($X+$L(STR))>255 WBF W STR Q
;;D:$X>0 WBF ;Flush what is in the buffer
;;F D WBF Q:'$L(STR) W $E(STR,1,255) S STR=$E(STR,256,$L(STR))
;;F Q:'$L(STR) W $E(STR,1,255) D WBF S STR=$E(STR,256,99999)
;
QUIT
;
WBF ;Write Buffer Flush - W !
;p34-included option for GTM
I $G(XWBOS)="" D INIT
W @$S(XWBOS'["GTM":"!",1:"#") ;*p34
Q
;
POST ; -- send eot and flush socket buffer
DO WRITE($C(4)),WBF:$X>0
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXWBRL 4433 printed Dec 13, 2024@02:37:20 Page 2
XWBRL ;OIFO-Oakland/REM - M2M Link Methods ;05/31/2005 15:13
+1 ;;1.1;RPC BROKER;**28,34**;Mar 28, 1997
+2 ;
+3 QUIT
+4 ;
+5 ;p34 -make sure that XWBOS is define - WRITE.
+6 ; -modified code to support the new meaning of $X in Cache
+7 ; 5.x - WRITE.
+8 ; -removed intervening lines that call WBF - WRITE.
+9 ; -added code to include option for GTM - WBF.
+10 ; -add line for XWBTCPM to read by Wally's non-call back service.
+11 ;
+12 ; ---------------------------------------------------------------------
+13 ; Methods for Read from and to TCP/IP Socket
+14 ; ---------------------------------------------------------------------
READ(XWBROOT,XWBREAD,XWBTO,XWBFIRST,XWBSTOP) ;
+1 NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,XWBCNT,XWBLEN
+2 SET STR=""
SET EOT=$CHAR(4)
SET DONE=0
SET LINE=0
+3 ;From XWBTCPM startup, One time thing *p34
+4 IF $DATA(XWBRBUF)=1
SET STR=XWBRBUF
SET XWBTO=0
SET XWBFIRST=0
KILL XWBRBUF
+5 ;
+6 ; -- READ needs work for length checking ; This needs work!!
+7 FOR
READ XWBX#XWBREAD:XWBTO
SET TOFLAG=$TEST
DO CHK
if 'XWBSTOP
Begin DoDot:1
+8 IF $LENGTH(STR)+$LENGTH(XWBX)>400
DO ADD(STR)
SET STR=""
+9 SET STR=STR_XWBX
+10 FOR
if STR'[$CHAR(10)
QUIT
DO ADD($PIECE(STR,$CHAR(10)))
SET STR=$PIECE(STR,$CHAR(10),2,999)
+11 IF STR[EOT
SET STR=$PIECE(STR,EOT)
DO ADD(STR)
SET DONE=1
QUIT
+12 SET PIECES=$LENGTH(STR,">")
+13 IF PIECES>1
DO ADD($PIECE(STR,">",1,PIECES-1)_">")
SET STR=$PIECE(STR,">",PIECES,999)
End DoDot:1
if DONE
QUIT
+14 ;
+15 QUIT 1
+16 ;
ADD(TXT) ; -- add new intake line
+1 SET LINE=LINE+1
+2 SET @XWBROOT@(LINE)=TXT
+3 QUIT
+4 ;
CHK ; -- check if first read and change timeout and chars to read
+1 ; -- could cause small msg to not process
IF 'TOFLAG
IF XWBFIRST
SET XWBSTOP=1
SET DONE=1
QUIT
+2 SET XWBFIRST=0
+3 ;M2M changed XWBTO=2
SET XWBREAD=100
SET XWBTO=2
+4 QUIT
+5 ;
+6 ;
+7 ; ---------------------------------------------------------------------
+8 ; Methods for Opening and Closing Socket
+9 ; ---------------------------------------------------------------------
OPEN(XWBPARMS) ; -- Open tcp/ip socket
+1 NEW I,POP
+2 SET POP=1
+3 DO INIT
+4 ;M2M changed name
DO SAVDEV^%ZISUTL("XWBM2M CLIENT")
+5 FOR I=1:1:XWBPARMS("RETRIES")
DO CALL^%ZISTCP(XWBPARMS("ADDRESS"),XWBPARMS("PORT"))
if 'POP
QUIT
+6 ; Device open
+7 ;
+8 IF 'POP
USE IO
QUIT 1
+9 ; Device not open
+10 QUIT 0
+11 ;
CLOSE ; -- close tcp/ip socket
+1 ; -- tell server to Stop() connection
+2 IF $GET(XWBOS)=""
DO INIT
+3 DO PRE
+4 DO WRITE($$XMLHDR^XWBUTL()_"<vistalink type='Gov.VA.Med.Foundations.CloseSocketRequest' ></vistalink>")
+5 DO POST
+6 ;
+7 ; -Read results from server close string. **M2M
+8 IF $GET(XWBPARMS("CCLOSERESULTS"))=""
SET XWBPARMS("CCLOSERESULTS")=$NAME(^TMP("XWBM2MRL",$JOB,"XML"))
+9 SET XWBROOT=XWBPARMS("CCLOSERESULTS")
KILL @XWBROOT
+10 SET XWBREAD=20
SET XWBTO=1
SET XWBFIRST=0
SET XWBSTOP=0
+11 SET XWBCOK=$$READ^XWBRL(XWBROOT,.XWBREAD,.XWBTO,.XWBFIRST,.XWBSTOP)
+12 ;
+13 DO FINAL
+14 DO CLOSE^%ZISTCP
+15 ; Change name **M2M
DO USE^%ZISUTL("XWBM2M CLIENT")
+16 DO RMDEV^%ZISUTL("XWBM2M CLIENT")
+17 QUIT
+18 ;
INIT ; -- set up variables needed in tcp/ip processing
+1 SET XWBOS=$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 XWBOS,XWBOS,XWBPARMS,XWBPARMS
+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 ;*p34-removed intervening lines that call WBF.
+2 ;
+3 ;*p34-make sure XWBOS is defined.
IF $GET(XWBOS)=""
DO INIT
+4 IF XWBOS="MSM"
WRITE STR
QUIT
+5 ; send data for DSM (requires buffer flush (!) every 511 chars)
+6 ; GT.M is the same as DSM.
+7 ; Use an arbitrary value of 255 as the Write limit.
+8 ;IF XWBOS="DSM"!(XWBOS="UNIX")!(XWBOS="OpenM) next line
+9 ;
+10 ;*p34-modified write to for Cache 5 in case less then 255 char.
+11 FOR
if '$LENGTH(STR)
QUIT
WRITE $EXTRACT(STR,1,255)
DO WBF
SET STR=$EXTRACT(STR,256,99999)
+12 ;
+13 ;Old code**
+14 ;;I $L(STR)<255 D:($X+$L(STR))>255 WBF W STR Q
+15 ;;D:$X>0 WBF ;Flush what is in the buffer
+16 ;;F D WBF Q:'$L(STR) W $E(STR,1,255) S STR=$E(STR,256,$L(STR))
+17 ;;F Q:'$L(STR) W $E(STR,1,255) D WBF S STR=$E(STR,256,99999)
+18 ;
+19 QUIT
+20 ;
WBF ;Write Buffer Flush - W !
+1 ;p34-included option for GTM
+2 IF $GET(XWBOS)=""
DO INIT
+3 ;*p34
WRITE @$SELECT(XWBOS'["GTM":"!",1:"#")
+4 QUIT
+5 ;
POST ; -- send eot and flush socket buffer
+1 DO WRITE($CHAR(4))
if $X>0
DO WBF
+2 QUIT
