source: FOIAVistA/trunk/r/RPC_BROKER-XWB/XWBRL.m@ 1742

Last change on this file since 1742 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1XWBRL ;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 ; ---------------------------------------------------------------------
16READ(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 ;
33ADD(TXT) ; -- add new intake line
34 SET LINE=LINE+1
35 SET @XWBROOT@(LINE)=TXT
36 QUIT
37 ;
38CHK ; -- 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 ; ---------------------------------------------------------------------
48OPEN(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 ;
60CLOSE ; -- 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 ;
79INIT ; -- 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 ;
83FINAL ; -- 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 ; ---------------------------------------------------------------------
90PRE ; -- prepare socket for writing
91 SET $X=0
92 QUIT
93 ;
94WRITE(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 ;
115WBF ;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 ;
121POST ; -- send eot and flush socket buffer
122 DO WRITE($C(4)),WBF:$X>0
123 QUIT
Note: See TracBrowser for help on using the repository browser.