Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XWBRL

XWBRL.m

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