| [613] | 1 | XWBRL ;OIFO-Oakland/REM - M2M Link Methods ;05/31/2005 15:13
|
|---|
| 2 | ;;1.1;RPC BROKER;**28,34**;Mar 28, 1997
|
|---|
| 3 | ;
|
|---|
| 4 | QUIT
|
|---|
| 5 | ;
|
|---|
| 6 | ;p34 -make sure that XWBOS is define - WRITE.
|
|---|
| 7 | ; -modified code to support the new meaning of $X in Cache
|
|---|
| 8 | ; 5.x - WRITE.
|
|---|
| 9 | ; -removed intervening lines that call WBF - WRITE.
|
|---|
| 10 | ; -added code to include option for GTM - WBF.
|
|---|
| 11 | ; -add line for XWBTCPM to read by Wally's non-call back service.
|
|---|
| 12 | ;
|
|---|
| 13 | ; ---------------------------------------------------------------------
|
|---|
| 14 | ; Methods for Read from and to TCP/IP Socket
|
|---|
| 15 | ; ---------------------------------------------------------------------
|
|---|
| 16 | READ(XWBROOT,XWBREAD,XWBTO,XWBFIRST,XWBSTOP) ;
|
|---|
| 17 | NEW X,EOT,OUT,STR,LINE,PIECES,DONE,TOFLAG,XWBCNT,XWBLEN
|
|---|
| 18 | SET STR="",EOT=$C(4),DONE=0,LINE=0
|
|---|
| 19 | ;From XWBTCPM startup, One time thing *p34
|
|---|
| 20 | I $D(XWBRBUF)=1 S STR=XWBRBUF,XWBTO=0,XWBFIRST=0 K XWBRBUF
|
|---|
| 21 | ;
|
|---|
| 22 | ; -- READ needs work for length checking ; This needs work!!
|
|---|
| 23 | FOR READ XWBX#XWBREAD:XWBTO SET TOFLAG=$T DO CHK DO:'XWBSTOP QUIT:DONE
|
|---|
| 24 | . IF $L(STR)+$L(XWBX)>400 DO ADD(STR) S STR=""
|
|---|
| 25 | . SET STR=STR_XWBX
|
|---|
| 26 | . FOR Q:STR'[$C(10) DO ADD($P(STR,$C(10))) SET STR=$P(STR,$C(10),2,999)
|
|---|
| 27 | . IF STR[EOT SET STR=$P(STR,EOT) DO ADD(STR) SET DONE=1 QUIT
|
|---|
| 28 | . SET PIECES=$L(STR,">")
|
|---|
| 29 | . IF PIECES>1 DO ADD($P(STR,">",1,PIECES-1)_">") SET STR=$P(STR,">",PIECES,999)
|
|---|
| 30 | ;
|
|---|
| 31 | QUIT 1
|
|---|
| 32 | ;
|
|---|
| 33 | ADD(TXT) ; -- add new intake line
|
|---|
| 34 | SET LINE=LINE+1
|
|---|
| 35 | SET @XWBROOT@(LINE)=TXT
|
|---|
| 36 | QUIT
|
|---|
| 37 | ;
|
|---|
| 38 | CHK ; -- check if first read and change timeout and chars to read
|
|---|
| 39 | IF 'TOFLAG,XWBFIRST SET XWBSTOP=1,DONE=1 QUIT ; -- could cause small msg to not process
|
|---|
| 40 | SET XWBFIRST=0
|
|---|
| 41 | SET XWBREAD=100,XWBTO=2 ;M2M changed XWBTO=2
|
|---|
| 42 | QUIT
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | ; ---------------------------------------------------------------------
|
|---|
| 46 | ; Methods for Opening and Closing Socket
|
|---|
| 47 | ; ---------------------------------------------------------------------
|
|---|
| 48 | OPEN(XWBPARMS) ; -- Open tcp/ip socket
|
|---|
| 49 | NEW I,POP
|
|---|
| 50 | SET POP=1
|
|---|
| 51 | DO INIT
|
|---|
| 52 | DO SAVDEV^%ZISUTL("XWBM2M CLIENT") ;M2M changed name
|
|---|
| 53 | FOR I=1:1:XWBPARMS("RETRIES") DO CALL^%ZISTCP(XWBPARMS("ADDRESS"),XWBPARMS("PORT")) QUIT:'POP
|
|---|
| 54 | ; Device open
|
|---|
| 55 | ;
|
|---|
| 56 | IF 'POP USE IO QUIT 1
|
|---|
| 57 | ; Device not open
|
|---|
| 58 | QUIT 0
|
|---|
| 59 | ;
|
|---|
| 60 | CLOSE ; -- close tcp/ip socket
|
|---|
| 61 | ; -- tell server to Stop() connection
|
|---|
| 62 | I $G(XWBOS)="" D INIT
|
|---|
| 63 | DO PRE
|
|---|
| 64 | DO WRITE($$XMLHDR^XWBUTL()_"<vistalink type='Gov.VA.Med.Foundations.CloseSocketRequest' ></vistalink>")
|
|---|
| 65 | DO POST
|
|---|
| 66 | ;
|
|---|
| 67 | ; -Read results from server close string. **M2M
|
|---|
| 68 | IF $G(XWBPARMS("CCLOSERESULTS"))="" SET XWBPARMS("CCLOSERESULTS")=$NA(^TMP("XWBM2MRL",$J,"XML"))
|
|---|
| 69 | SET XWBROOT=XWBPARMS("CCLOSERESULTS") K @XWBROOT
|
|---|
| 70 | SET XWBREAD=20,XWBTO=1,XWBFIRST=0,XWBSTOP=0
|
|---|
| 71 | SET XWBCOK=$$READ^XWBRL(XWBROOT,.XWBREAD,.XWBTO,.XWBFIRST,.XWBSTOP)
|
|---|
| 72 | ;
|
|---|
| 73 | DO FINAL
|
|---|
| 74 | DO CLOSE^%ZISTCP
|
|---|
| 75 | DO USE^%ZISUTL("XWBM2M CLIENT") ; Change name **M2M
|
|---|
| 76 | DO RMDEV^%ZISUTL("XWBM2M CLIENT")
|
|---|
| 77 | QUIT
|
|---|
| 78 | ;
|
|---|
| 79 | INIT ; -- set up variables needed in tcp/ip processing
|
|---|
| 80 | SET XWBOS=$S(^%ZOSF("OS")["DSM":"DSM",^("OS")["UNIX":"UNIX",^("OS")["OpenM":"OpenM",1:"MSM")
|
|---|
| 81 | QUIT
|
|---|
| 82 | ;
|
|---|
| 83 | FINAL ; -- kill variables used in tcp/ip processing
|
|---|
| 84 | KILL XWBOS,XWBOS,XWBPARMS,XWBPARMS
|
|---|
| 85 | QUIT
|
|---|
| 86 | ;
|
|---|
| 87 | ; ---------------------------------------------------------------------
|
|---|
| 88 | ; Methods for Writing to TCP/IP Socket
|
|---|
| 89 | ; ---------------------------------------------------------------------
|
|---|
| 90 | PRE ; -- prepare socket for writing
|
|---|
| 91 | SET $X=0
|
|---|
| 92 | QUIT
|
|---|
| 93 | ;
|
|---|
| 94 | WRITE(STR) ; -- Write a data string to socket
|
|---|
| 95 | ;*p34-removed intervening lines that call WBF.
|
|---|
| 96 | ;
|
|---|
| 97 | I $G(XWBOS)="" D INIT ;*p34-make sure XWBOS is defined.
|
|---|
| 98 | IF XWBOS="MSM" WRITE STR QUIT
|
|---|
| 99 | ; send data for DSM (requires buffer flush (!) every 511 chars)
|
|---|
| 100 | ; GT.M is the same as DSM.
|
|---|
| 101 | ; Use an arbitrary value of 255 as the Write limit.
|
|---|
| 102 | ;IF XWBOS="DSM"!(XWBOS="UNIX")!(XWBOS="OpenM) next line
|
|---|
| 103 | ;
|
|---|
| 104 | ;*p34-modified write to for Cache 5 in case less then 255 char.
|
|---|
| 105 | F Q:'$L(STR) W $E(STR,1,255) D WBF S STR=$E(STR,256,99999)
|
|---|
| 106 | ;
|
|---|
| 107 | ;Old code**
|
|---|
| 108 | ;;I $L(STR)<255 D:($X+$L(STR))>255 WBF W STR Q
|
|---|
| 109 | ;;D:$X>0 WBF ;Flush what is in the buffer
|
|---|
| 110 | ;;F D WBF Q:'$L(STR) W $E(STR,1,255) S STR=$E(STR,256,$L(STR))
|
|---|
| 111 | ;;F Q:'$L(STR) W $E(STR,1,255) D WBF S STR=$E(STR,256,99999)
|
|---|
| 112 | ;
|
|---|
| 113 | QUIT
|
|---|
| 114 | ;
|
|---|
| 115 | WBF ;Write Buffer Flush - W !
|
|---|
| 116 | ;p34-included option for GTM
|
|---|
| 117 | I $G(XWBOS)="" D INIT
|
|---|
| 118 | W @$S(XWBOS'["GTM":"!",1:"#") ;*p34
|
|---|
| 119 | Q
|
|---|
| 120 | ;
|
|---|
| 121 | POST ; -- send eot and flush socket buffer
|
|---|
| 122 | DO WRITE($C(4)),WBF:$X>0
|
|---|
| 123 | QUIT
|
|---|
