HLCSAS1 ;ISCSF/RWF - Read data ;02/05/2004 08:06
;;1.6;HEALTH LEVEL SEVEN;**43,57,91,109**;Oct 13, 1995
Q
DATA(ROOT,STAT) ;get Data
N I,M,HLROOT
D DCODE(HCSDAT),TRACE^HLCSAS("DECODE "_HCSDAT)
;Check if data type is OK
;I ...
S HLROOT=$$SAVE("I")
F I=1:1 S M=$$DREAD() Q:HCSER!M S (@ROOT@(I),@HLROOT@(I,0))=HCSDAT
S @HLROOT@(0)="^^"_(I-1)_"^"_(I-1)_"^"_$$DT^XLFDT
;If we got it all
D SEND^HLCSAS($S(HCSER:"500 Data error",1:"220 OK"))
D LLCNT^HLCSTCP(HLDP,1)
Q
;
SAVE(HLTP) ;save to file 772, HLTP: I=input, O=output
N HLJ,HLMID,HLTIEN,HLDT,HLX,HLY,X,Y ;HL*1.6*91
D TCP^HLTF(.HLMID,.HLTIEN,.HLDT) Q:'HLTIEN ""
S X="HLJ(773,"""_HLTIEN_","")"
;3=transmission type, 4=priority, 7=Logical Link, 20=status, 100=processed
S @X@(3)=HLTP,@X@(4)="I",@X@(7)=HLDP,@X@(20)=3,@X@(100)=$$NOW^XLFDT
D FILE^HLDIE("K","HLJ","","SAVE","HLCSAS1") ;HL*1.6*109
S (HLX,X)=+^HLMA(HLTIEN,0),(HLY,Y)=$NA(^HL(772,X,"IN")) ;HL*1.6*91
D SNMSP(+HLX,$S($G(HLP("NAMESPACE"))]"":HLP("NAMESPACE"),1:"MPI")) ;HL*1.6*91
Q HLY ;HL*1.6*91
;
SNMSP(IEN772,NMSP) ; Store NMSP in IEN772 (Created by HL*1.6*91)
N HLJ,X,Y
QUIT:'$D(^HL(772,+$G(IEN772),0))!($G(NMSP)']"") ;->
S X="HLJ(772,"""_+IEN772_","")"
S @X@(16)=NMSP
D FILE^HLDIE("","HLJ","","SNMSP","HLCSAS1") ; HL*1.6*109
QUIT
;
SDATA(ROOT,TYPE) ;Send data from a source
N I,X,Y,Z,L,D,HLROOT
S ROOT=$NA(@ROOT),X=ROOT,Y=$E(ROOT,1,$L(ROOT)-1),HCSER=0
D SEND^HLCSAS("DATA PARAM="_TYPE)
S X=ROOT,HLROOT=$$SAVE("O")
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)
S @HLROOT@(0)="^^"_(I-1)_"^"_(I-1)_"^"_$$DT^XLFDT
D DSEND($C(27,27,27)) ;Tell other end we'r done
D LLCNT^HLCSTCP(HLDP,4)
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,HCSDAT)="",HCSER=0
S L=$$LREAD(3) Q:HCSER 1
I L'?3N S HCSER="1 Out of sync: "_L Q 1
I L>0 S HCSDAT=$$LREAD(L)
Q HCSDAT=$C(27,27,27)
DSEND(D) ;Data send
N L
S L=$L(D),L=$E(1000+L,2,4)
W L,D,! ;Flush buffer
Q
LREAD(N) ;Read N char
N D,C,P S D="",C=N,HCSER=0
F D Q:'C!HCSER
. R P#C:HLDREAD E S HCSER=1 Q
. S D=D_P,C=N-$L(D)
. Q
Q D
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSAS1 2239 printed Jun 11, 2024@21:43 Page 2
HLCSAS1 ;ISCSF/RWF - Read data ;02/05/2004 08:06
+1 ;;1.6;HEALTH LEVEL SEVEN;**43,57,91,109**;Oct 13, 1995
+2 QUIT
DATA(ROOT,STAT) ;get Data
+1 NEW I,M,HLROOT
+2 DO DCODE(HCSDAT)
DO TRACE^HLCSAS("DECODE "_HCSDAT)
+3 ;Check if data type is OK
+4 ;I ...
+5 SET HLROOT=$$SAVE("I")
+6 FOR I=1:1
SET M=$$DREAD()
if HCSER!M
QUIT
SET (@ROOT@(I),@HLROOT@(I,0))=HCSDAT
+7 SET @HLROOT@(0)="^^"_(I-1)_"^"_(I-1)_"^"_$$DT^XLFDT
+8 ;If we got it all
+9 DO SEND^HLCSAS($SELECT(HCSER:"500 Data error",1:"220 OK"))
+10 DO LLCNT^HLCSTCP(HLDP,1)
+11 QUIT
+12 ;
SAVE(HLTP) ;save to file 772, HLTP: I=input, O=output
+1 ;HL*1.6*91
NEW HLJ,HLMID,HLTIEN,HLDT,HLX,HLY,X,Y
+2 DO TCP^HLTF(.HLMID,.HLTIEN,.HLDT)
if 'HLTIEN
QUIT ""
+3 SET X="HLJ(773,"""_HLTIEN_","")"
+4 ;3=transmission type, 4=priority, 7=Logical Link, 20=status, 100=processed
+5 SET @X@(3)=HLTP
SET @X@(4)="I"
SET @X@(7)=HLDP
SET @X@(20)=3
SET @X@(100)=$$NOW^XLFDT
+6 ;HL*1.6*109
DO FILE^HLDIE("K","HLJ","","SAVE","HLCSAS1")
+7 ;HL*1.6*91
SET (HLX,X)=+^HLMA(HLTIEN,0)
SET (HLY,Y)=$NAME(^HL(772,X,"IN"))
+8 ;HL*1.6*91
DO SNMSP(+HLX,$SELECT($GET(HLP("NAMESPACE"))]"":HLP("NAMESPACE"),1:"MPI"))
+9 ;HL*1.6*91
QUIT HLY
+10 ;
SNMSP(IEN772,NMSP) ; Store NMSP in IEN772 (Created by HL*1.6*91)
+1 NEW HLJ,X,Y
+2 ;->
if '$DATA(^HL(772,+$GET(IEN772),0))!($GET(NMSP)']"")
QUIT
+3 SET X="HLJ(772,"""_+IEN772_","")"
+4 SET @X@(16)=NMSP
+5 ; HL*1.6*109
DO FILE^HLDIE("","HLJ","","SNMSP","HLCSAS1")
+6 QUIT
+7 ;
SDATA(ROOT,TYPE) ;Send data from a source
+1 NEW I,X,Y,Z,L,D,HLROOT
+2 SET ROOT=$NAME(@ROOT)
SET X=ROOT
SET Y=$EXTRACT(ROOT,1,$LENGTH(ROOT)-1)
SET HCSER=0
+3 DO SEND^HLCSAS("DATA PARAM="_TYPE)
+4 SET X=ROOT
SET HLROOT=$$SAVE("O")
+5 FOR I=1:1
SET X=$QUERY(@X)
if $EXTRACT(X,1,$LENGTH(Y))'=Y
QUIT
SET Z=@X
SET @HLROOT@(I,0)=Z
DO DSEND(Z)
+6 SET @HLROOT@(0)="^^"_(I-1)_"^"_(I-1)_"^"_$$DT^XLFDT
+7 ;Tell other end we'r done
DO DSEND($CHAR(27,27,27))
+8 DO LLCNT^HLCSTCP(HLDP,4)
+9 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,HCSDAT)=""
SET HCSER=0
+2 SET L=$$LREAD(3)
if HCSER
QUIT 1
+3 IF L'?3N
SET HCSER="1 Out of sync: "_L
QUIT 1
+4 IF L>0
SET HCSDAT=$$LREAD(L)
+5 QUIT HCSDAT=$CHAR(27,27,27)
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
LREAD(N) ;Read N char
+1 NEW D,C,P
SET D=""
SET C=N
SET HCSER=0
+2 FOR
Begin DoDot:1
+3 READ P#C:HLDREAD
IF '$TEST
SET HCSER=1
QUIT
+4 SET D=D_P
SET C=N-$LENGTH(D)
+5 QUIT
End DoDot:1
if 'C!HCSER
QUIT
+6 QUIT D
