XUSC1S1 ;ISCSF/RWF - Read data ;04/01/2002 17:13
;;8.0;KERNEL;**283**;Jul 10, 1995
Q
DATA(ROOT,STAT) ;get Data
N I,M
D DCODE(XUSCDAT),TRACE^XUSC1S("DECODE "_XUSCDAT)
;Check if data type is OK
;I ...
F I=1:1 S M=$$DREAD() Q:XUSCER!M S @ROOT@(I)=XUSCDAT
;If we got it all
D SEND^XUSC1S($S(XUSCER:"500 Data error",1:"220 OK"))
Q
;
SDATA(ROOT,TYPE) ;Send data from a source
N X,Y,L,D
S ROOT=$NA(@ROOT),X=ROOT,Y=$E(ROOT,1,$L(ROOT)-1),XUSCER=0
D SEND^XUSC1S("DATA PARAM="_TYPE)
S X=ROOT
F S X=$Q(@X) Q:$E(X,1,$L(Y))'=Y D DSEND(@X)
D ESEND ;Tell other end we'r done
Q
DCODE(D) ;Decode a DATA string
S D=$$UP^XLFSTR(D),D=$P(D,"PARAM=",2,99)
F I=1:1 S STAT("P"_I)=$P(D,",",I) Q:$P(D,",",I+1)=""
Q
DREAD() ;Data read
N L,D,R S (D,XUSCDAT)="",XUSCER=0
S L=$$LREAD(3) Q:XUSCER 1
I L<0 S XUSCDAT="" Q 1
I L'?3N S XUSCER="1 Out of sync: "_L Q 1
I L>0 S XUSCDAT=$$LREAD(L)
Q 0
DSEND(D) ;Data send
N L
S L=$L(D),L=$E(1000+L,2,4)
W L,D,! ;Flush buffer
Q
ESEND ;Send end of data message
W "-10",!
Q
LREAD(N) ;Read N char
N D,C,P S D="",C=N,XUSCER=0
F D Q:'C!XUSCER
. R P#C:XUSCTIME E S XUSCER=1 Q
. D TRACE^XUSC1S("LREAD "_$A(P)) ;*rwf
. S D=D_P,C=N-$L(D)
. Q
Q D
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSC1S1 1241 printed Apr 09, 2024@21:16:42 Page 2
XUSC1S1 ;ISCSF/RWF - Read data ;04/01/2002 17:13
+1 ;;8.0;KERNEL;**283**;Jul 10, 1995
+2 QUIT
DATA(ROOT,STAT) ;get Data
+1 NEW I,M
+2 DO DCODE(XUSCDAT)
DO TRACE^XUSC1S("DECODE "_XUSCDAT)
+3 ;Check if data type is OK
+4 ;I ...
+5 FOR I=1:1
SET M=$$DREAD()
if XUSCER!M
QUIT
SET @ROOT@(I)=XUSCDAT
+6 ;If we got it all
+7 DO SEND^XUSC1S($SELECT(XUSCER:"500 Data error",1:"220 OK"))
+8 QUIT
+9 ;
SDATA(ROOT,TYPE) ;Send data from a source
+1 NEW X,Y,L,D
+2 SET ROOT=$NAME(@ROOT)
SET X=ROOT
SET Y=$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)
SET XUSCER=0
+3 DO SEND^XUSC1S("DATA PARAM="_TYPE)
+4 SET X=ROOT
+5 FOR
SET X=$QUERY(@X)
if $EXTRACT(X,1,$LENGTH(Y))'=Y
QUIT
DO DSEND(@X)
+6 ;Tell other end we'r done
DO ESEND
+7 QUIT
DCODE(D) ;Decode a DATA string
+1 SET D=$$UP^XLFSTR(D)
SET D=$PIECE(D,"PARAM=",2,99)
+2 FOR I=1:1
SET STAT("P"_I)=$PIECE(D,",",I)
if $PIECE(D,",",I+1)=""
QUIT
+3 QUIT
DREAD() ;Data read
+1 NEW L,D,R
SET (D,XUSCDAT)=""
SET XUSCER=0
+2 SET L=$$LREAD(3)
if XUSCER
QUIT 1
+3 IF L<0
SET XUSCDAT=""
QUIT 1
+4 IF L'?3N
SET XUSCER="1 Out of sync: "_L
QUIT 1
+5 IF L>0
SET XUSCDAT=$$LREAD(L)
+6 QUIT 0
DSEND(D) ;Data send
+1 NEW L
+2 SET L=$LENGTH(D)
SET L=$EXTRACT(1000+L,2,4)
+3 ;Flush buffer
WRITE L,D,!
+4 QUIT
ESEND ;Send end of data message
+1 WRITE "-10",!
+2 QUIT
LREAD(N) ;Read N char
+1 NEW D,C,P
SET D=""
SET C=N
SET XUSCER=0
+2 FOR
Begin DoDot:1
+3 READ P#C:XUSCTIME
IF '$TEST
SET XUSCER=1
QUIT
+4 ;*rwf
DO TRACE^XUSC1S("LREAD "_$ASCII(P))
+5 SET D=D_P
SET C=N-$LENGTH(D)
+6 QUIT
End DoDot:1
if 'C!XUSCER
QUIT
+7 QUIT D
