source: FOIAVistA/trunk/r/RPC_BROKER-XWB/XWBRW.m@ 765

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1XWBRW ;ISF/RWF - Read/Write for Broker TCP ;08/03/2004 15:09
2 ;;1.1;RPC BROKER;**35**;Mar 28, 1997
3 Q
4 ;
5 ;XWBRBUF is global
6 ;SE is a flag to skip error for short read. From PRSB+41^XWBBRK
7BREAD(L,TO,SE) ;read tcp buffer, L is length, TO is timeout
8 N R,S,DONE,C
9 I L'>0 Q ""
10 I $L(XWBRBUF)'<L S R=$E(XWBRBUF,1,L),XWBRBUF=$E(XWBRBUF,L+1,999999) Q R
11 S R="",DONE=0,L=+L,C=0
12 S TO=$S($G(TO)>0:TO,$G(XWBTIME(1))>0:XWBTIME(1),1:60)/2+1
13 U XWBTDEV
14 F D Q:DONE
15 . S S=L-$L(R),R=R_$E(XWBRBUF,1,S),XWBRBUF=$E(XWBRBUF,S+1,999999)
16 . I ($L(R)=L)!(R[$C(4))!(C>TO) S DONE=1 Q
17 . R XWBRBUF:2 S:'$T C=C+1 S:$L(XWBRBUF) C=0
18 . I $G(XWBDEBUG)>2,$L(XWBRBUF) D LOG^XWBDLOG("rd: "_$E(XWBRBUF,1,252))
19 . Q
20 I $L(R)<L,'$G(SE) S $ECODE=",U411," ;Throw Error, Did not read full length
21 Q R
22 ;
23QSND(XWBR) ;Quick send
24 S XWBPTYPE=1,XWBERROR="",XWBSEC="" D SND
25 Q
26 ;
27ESND(XWBR) ;Send from ETRAP
28 S XWBPTYPE=1 D SND
29 Q
30 ;
31SND ; Send a responce
32 N XWBSBUF S XWBSBUF=""
33 U XWBTDEV
34 ;
35 D SNDERR ;Send any error info
36 D SNDDATA ;Send the data
37 ;D WRITE($C(4)) ;EOT
38 D WRITE($C(4)),WBF
39 Q
40 ;
41SNDDATA ;Send the data part
42 N I,D
43 ; -- single value
44 I XWBPTYPE=1 D WRITE($G(XWBR)) Q
45 ; -- table delimited by CR+LF
46 I XWBPTYPE=2 D Q
47 . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE(XWBR(I)),WRITE($C(13,10))
48 ; -- word processing
49 I XWBPTYPE=3 D Q
50 . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE(XWBR(I)) D:XWBWRAP WRITE($C(13,10))
51 ; -- global array
52 I XWBPTYPE=4 D Q
53 . I $E($G(XWBR))'="^" Q
54 . S I=$G(XWBR) Q:I="" S T=$E(I,1,$L(I)-1)
55 . ;Only send root node if non-null.
56 . I $D(@I)>10 S D=@I I $L(D) D WRITE(D),WRITE($C(13,10)):XWBWRAP&(D'=$C(13,10))
57 . F S I=$Q(@I) Q:I=""!(I'[T) S D=@I D WRITE(D),WRITE($C(13,10)):XWBWRAP&(D'=$C(13,10))
58 . I $D(@XWBR) K @XWBR
59 ; -- global instance
60 I XWBPTYPE=5 D Q
61 . I $E($G(XWBR))'="^" Q
62 . S XWBR=$G(@XWBR) D WRITE(XWBR) Q
63 ; -- variable length records only good upto 255 char)
64 I XWBPTYPE=6 D
65 . S I="" F S I=$O(XWBR(I)) Q:I="" D WRITE($C($L(XWBR(I)))),WRITE(XWBR(I))
66 Q
67 ;
68SNDERR ;send error information
69 ;XWBSEC is the security packet, XWBERROR is application packet
70 N X
71 S $X=0 ;Start with zero
72 S X=$E($G(XWBSEC),1,255)
73 D WRITE($C($L(X))_X)
74 S X=$E($G(XWBERROR),1,255)
75 D WRITE($C($L(X))_X)
76 S XWBERROR="",XWBSEC="" ;clears parameters
77 Q
78 ;
79WRITE(STR) ;Write a data string
80 ; send data for DSM (requires buffer flush (!) every 511 chars)
81 ;IF XWBOS="DSM"!(XWBOS="UNIX")!(XWBOS="OpenM) next line
82 F Q:'$L(STR) D
83 . I $L(XWBSBUF)+$L(STR)>240 D WBF
84 . S XWBSBUF=XWBSBUF_$E(STR,1,255),STR=$E(STR,256,99999)
85 Q
86WBF ;Write Buffer Flush
87 Q:'$L(XWBSBUF)
88 I $G(XWBDEBUG)>2,$L(XWBSBUF) D LOG^XWBDLOG("wrt ("_$L(XWBSBUF)_"): "_$E(XWBSBUF,1,247))
89 W XWBSBUF,@XWBT("BF")
90 S XWBSBUF=""
91 Q
Note: See TracBrowser for help on using the repository browser.