| 1 | XUSC1S1 ;ISCSF/RWF - Read data ;04/01/2002 17:13
|
|---|
| 2 | ;;8.0;KERNEL;**283**;Jul 10, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | DATA(ROOT,STAT) ;get Data
|
|---|
| 5 | N I,M
|
|---|
| 6 | D DCODE(XUSCDAT),TRACE^XUSC1S("DECODE "_XUSCDAT)
|
|---|
| 7 | ;Check if data type is OK
|
|---|
| 8 | ;I ...
|
|---|
| 9 | F I=1:1 S M=$$DREAD() Q:XUSCER!M S @ROOT@(I)=XUSCDAT
|
|---|
| 10 | ;If we got it all
|
|---|
| 11 | D SEND^XUSC1S($S(XUSCER:"500 Data error",1:"220 OK"))
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | SDATA(ROOT,TYPE) ;Send data from a source
|
|---|
| 15 | N X,Y,L,D
|
|---|
| 16 | S ROOT=$NA(@ROOT),X=ROOT,Y=$E(ROOT,1,$L(ROOT)-1),XUSCER=0
|
|---|
| 17 | D SEND^XUSC1S("DATA PARAM="_TYPE)
|
|---|
| 18 | S X=ROOT
|
|---|
| 19 | F S X=$Q(@X) Q:$E(X,1,$L(Y))'=Y D DSEND(@X)
|
|---|
| 20 | D ESEND ;Tell other end we'r done
|
|---|
| 21 | Q
|
|---|
| 22 | DCODE(D) ;Decode a DATA string
|
|---|
| 23 | S D=$$UP^XLFSTR(D),D=$P(D,"PARAM=",2,99)
|
|---|
| 24 | F I=1:1 S STAT("P"_I)=$P(D,",",I) Q:$P(D,",",I+1)=""
|
|---|
| 25 | Q
|
|---|
| 26 | DREAD() ;Data read
|
|---|
| 27 | N L,D,R S (D,XUSCDAT)="",XUSCER=0
|
|---|
| 28 | S L=$$LREAD(3) Q:XUSCER 1
|
|---|
| 29 | I L<0 S XUSCDAT="" Q 1
|
|---|
| 30 | I L'?3N S XUSCER="1 Out of sync: "_L Q 1
|
|---|
| 31 | I L>0 S XUSCDAT=$$LREAD(L)
|
|---|
| 32 | Q 0
|
|---|
| 33 | DSEND(D) ;Data send
|
|---|
| 34 | N L
|
|---|
| 35 | S L=$L(D),L=$E(1000+L,2,4)
|
|---|
| 36 | W L,D,! ;Flush buffer
|
|---|
| 37 | Q
|
|---|
| 38 | ESEND ;Send end of data message
|
|---|
| 39 | W "-10",!
|
|---|
| 40 | Q
|
|---|
| 41 | LREAD(N) ;Read N char
|
|---|
| 42 | N D,C,P S D="",C=N,XUSCER=0
|
|---|
| 43 | F D Q:'C!XUSCER
|
|---|
| 44 | . R P#C:XUSCTIME E S XUSCER=1 Q
|
|---|
| 45 | . D TRACE^XUSC1S("LREAD "_$A(P)) ;*rwf
|
|---|
| 46 | . S D=D_P,C=N-$L(D)
|
|---|
| 47 | . Q
|
|---|
| 48 | Q D
|
|---|
