| [613] | 1 | HLCSAS1 ;ISCSF/RWF - Read data ;02/05/2004 08:06
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**43,57,91,109**;Oct 13, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | DATA(ROOT,STAT) ;get Data
|
|---|
| 5 | N I,M,HLROOT
|
|---|
| 6 | D DCODE(HCSDAT),TRACE^HLCSAS("DECODE "_HCSDAT)
|
|---|
| 7 | ;Check if data type is OK
|
|---|
| 8 | ;I ...
|
|---|
| 9 | S HLROOT=$$SAVE("I")
|
|---|
| 10 | F I=1:1 S M=$$DREAD() Q:HCSER!M S (@ROOT@(I),@HLROOT@(I,0))=HCSDAT
|
|---|
| 11 | S @HLROOT@(0)="^^"_(I-1)_"^"_(I-1)_"^"_$$DT^XLFDT
|
|---|
| 12 | ;If we got it all
|
|---|
| 13 | D SEND^HLCSAS($S(HCSER:"500 Data error",1:"220 OK"))
|
|---|
| 14 | D LLCNT^HLCSTCP(HLDP,1)
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | SAVE(HLTP) ;save to file 772, HLTP: I=input, O=output
|
|---|
| 18 | N HLJ,HLMID,HLTIEN,HLDT,HLX,HLY,X,Y ;HL*1.6*91
|
|---|
| 19 | D TCP^HLTF(.HLMID,.HLTIEN,.HLDT) Q:'HLTIEN ""
|
|---|
| 20 | S X="HLJ(773,"""_HLTIEN_","")"
|
|---|
| 21 | ;3=transmission type, 4=priority, 7=Logical Link, 20=status, 100=processed
|
|---|
| 22 | S @X@(3)=HLTP,@X@(4)="I",@X@(7)=HLDP,@X@(20)=3,@X@(100)=$$NOW^XLFDT
|
|---|
| 23 | D FILE^HLDIE("K","HLJ","","SAVE","HLCSAS1") ;HL*1.6*109
|
|---|
| 24 | S (HLX,X)=+^HLMA(HLTIEN,0),(HLY,Y)=$NA(^HL(772,X,"IN")) ;HL*1.6*91
|
|---|
| 25 | D SNMSP(+HLX,$S($G(HLP("NAMESPACE"))]"":HLP("NAMESPACE"),1:"MPI")) ;HL*1.6*91
|
|---|
| 26 | Q HLY ;HL*1.6*91
|
|---|
| 27 | ;
|
|---|
| 28 | SNMSP(IEN772,NMSP) ; Store NMSP in IEN772 (Created by HL*1.6*91)
|
|---|
| 29 | N HLJ,X,Y
|
|---|
| 30 | QUIT:'$D(^HL(772,+$G(IEN772),0))!($G(NMSP)']"") ;->
|
|---|
| 31 | S X="HLJ(772,"""_+IEN772_","")"
|
|---|
| 32 | S @X@(16)=NMSP
|
|---|
| 33 | D FILE^HLDIE("","HLJ","","SNMSP","HLCSAS1") ; HL*1.6*109
|
|---|
| 34 | QUIT
|
|---|
| 35 | ;
|
|---|
| 36 | SDATA(ROOT,TYPE) ;Send data from a source
|
|---|
| 37 | N I,X,Y,Z,L,D,HLROOT
|
|---|
| 38 | S ROOT=$NA(@ROOT),X=ROOT,Y=$E(ROOT,1,$L(ROOT)-1),HCSER=0
|
|---|
| 39 | D SEND^HLCSAS("DATA PARAM="_TYPE)
|
|---|
| 40 | S X=ROOT,HLROOT=$$SAVE("O")
|
|---|
| 41 | F I=1:1 S X=$Q(@X) Q:$E(X,1,$L(Y))'=Y S Z=@X,@HLROOT@(I,0)=Z D DSEND(Z)
|
|---|
| 42 | S @HLROOT@(0)="^^"_(I-1)_"^"_(I-1)_"^"_$$DT^XLFDT
|
|---|
| 43 | D DSEND($C(27,27,27)) ;Tell other end we'r done
|
|---|
| 44 | D LLCNT^HLCSTCP(HLDP,4)
|
|---|
| 45 | Q
|
|---|
| 46 | DCODE(D) ;Decode a DATA string
|
|---|
| 47 | S D=$$UP^XLFSTR(D),D=$P(D,"PARAM=",2,99)
|
|---|
| 48 | F I=1:1 S STAT("P"_I)=$P(D,",",I) Q:$P(D,",",I+1)=""
|
|---|
| 49 | Q
|
|---|
| 50 | DREAD() ;Data read
|
|---|
| 51 | N L,D,R S (D,HCSDAT)="",HCSER=0
|
|---|
| 52 | S L=$$LREAD(3) Q:HCSER 1
|
|---|
| 53 | I L'?3N S HCSER="1 Out of sync: "_L Q 1
|
|---|
| 54 | I L>0 S HCSDAT=$$LREAD(L)
|
|---|
| 55 | Q HCSDAT=$C(27,27,27)
|
|---|
| 56 | DSEND(D) ;Data send
|
|---|
| 57 | N L
|
|---|
| 58 | S L=$L(D),L=$E(1000+L,2,4)
|
|---|
| 59 | W L,D,! ;Flush buffer
|
|---|
| 60 | Q
|
|---|
| 61 | LREAD(N) ;Read N char
|
|---|
| 62 | N D,C,P S D="",C=N,HCSER=0
|
|---|
| 63 | F D Q:'C!HCSER
|
|---|
| 64 | . R P#C:HLDREAD E S HCSER=1 Q
|
|---|
| 65 | . S D=D_P,C=N-$L(D)
|
|---|
| 66 | . Q
|
|---|
| 67 | Q D
|
|---|
