source: WorldVistAEHR/trunk/r/RPC_BROKER-XWB/XWBCAGNT.m@ 1076

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1XWBCAGNT ;ISC-SF/EG,RWF - Connect to Remote TCP Client Agent ;2/12/98 16:15<<= NOT VERIFIED >
2 ;;1.1;RPC BROKER;**2**;Mar 28, 1997
3 Q
4 ;
5CMD(XWBRET,QUES,PARAM) ;Call daemon and get responce <e.f.>
6 N IPA,SOCK S XWBRET="",IPA=$G(IO("IP")),SOCK=9200 Q:IPA="" 0
7 I $G(IO)="" D HOME^%ZIS
8 D CALL^%ZISTCP(IPA,SOCK,3) I POP Q 0
9 D SEND(QUES,$G(PARAM)),REC(.XWBRET)
10 D CLOSE^%ZISTCP
11 Q 1
12 ;
13OPEN(IP,SKT) ; - connect to remote <extrinsic function>
14 D HOME^%ZIS:'$D(IO(0)),SAVDEV^%ZISUTL("XWBCAGENT HOME")
15 D CALL^%ZISTCP(IP,SKT,3)
16 Q
17 ;
18SEND(S,P) ; - send message <procedure>
19 N $ETRAP S $ETRAP="S $EC="""" Q"
20 S S=$$SETMSG(S,$G(P))
21 U IO W S,!
22 Q
23 ;
24REC(BODY) ; - receive message <extrinsic function>
25 N LEN,Y
26 U IO S BODY("HDR")="~",BODY("HDR")=$$SREAD(5) ; -- get header
27 Q:BODY("HDR")'="{XWB}" ; -- quit if no responce
28 S LEN=$$SREAD(5),BODY("ID")=$$SREAD(+LEN) ; -- get PID
29 S LEN=$$SREAD(5),BODY(0)=$$SREAD(+LEN) ; -- get rpc name
30 S LEN=$$SREAD(5) D:+LEN BREAD(+LEN,.BODY) ; -- get rpc parameter
31 S LEN=$$SREAD(1) ; -- read terminator
32 Q
33 ;
34SETMSG(S,PAR) ; - format message <extrinsic function>
35 N L,F,PID
36 IF ('$D(S))!('$D(PAR)) Q ""
37 S F=100000
38 S PID=$J
39 S L=$L(PID)
40 S PID=$E(F+L,2,6)_PID
41 S L=$L(S),S=$E(F+L,2,6)_S
42 S L=$L(PAR),PAR=$E(F+L,2,6)_PAR
43 Q "{XWB}"_PID_S_PAR_$C(23)
44 ;
45CLOSE ; - close device <procedure>
46 D CLOSE^%ZISTCP,USE^%ZISUTL("XWBCAGENT HOME"),RMDEV^%ZISUTL("XWBCAGENT HOME")
47 Q
48 ;
49BREAD(L,B) ;read tcp buffer, L is length <extrinsic function>
50 N E,X,T,DONE,XWBTIME,Y,IX,$ETRAP S $ETRAP="S $EC="""" Q"
51 S (T,E,DONE)=0,XWBTIME=10,IX=1,B=L,L=$S(L<256:L,1:128) Q:L'>0 ""
52BR2 R X#L:XWBTIME
53 S E=X
54 IF $L(E)<L F D Q:DONE
55 . IF $L(E)=L S DONE=1 Q
56 . R X#(L-$L(E)):XWBTIME
57 . S E=E_X
58 S B(IX)=E,T=T+$L(E)
59 I T'=B S L=$S(B-T>255:128,1:B-T),IX=IX+1 G BR2
60 Q
61 ;
62SREAD(L) ;read short tcp buffer, L is length <extrinsic function>
63 N C,E,X,DONE,XWBTIME,$ETRAP S $ETRAP="S $EC="""" Q """""
64 S (C,E,DONE)=0,XWBTIME=10 Q:L'>0 ""
65 R X#L:XWBTIME
66 S E=X IF $L(E)<L R X#(L-$L(E)):XWBTIME S E=E_X
67 Q E
68 ;
Note: See TracBrowser for help on using the repository browser.