XUSC1S1.m

XUSC1S1 ;ISCSF/RWF - Read data ;04/01/2002  17:13 [ 07/29/2004   9:01 AM ]

 ;;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

XUSC1S1   ;ISCSF/RWF - Read data ;04/01/2002  17:13 [ 07/29/2004   9:01 AM ]

 +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