- 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 Feb 19, 2025@00:03:45 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