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