Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLTCPB.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLTCPB.m (modified) (8 diffs)

FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLTCPB.m

@@ -1 +1 @@
 RAHLTCPB ; HIRMFO/REL,GJC,BNT,PAV - Rad/Nuc Med HL7 TCP/IP Bridge;05/21/99
- ;;5.0;Radiology/Nuclear Medicine;**12,17,25,51,71,81,84**;Mar 16, 1998;Build 13
+ ;;5.0;Radiology/Nuclear Medicine;**12,17,25,51,71,81**;Mar 16, 1998;Build 12
  ; 07/05/2006 BAY/KAM Remedy Call 124379 Eliminate unneeded ORM msgs
- ; 09/01/2006   Acomodate multiple ORC/OBR segments Patch 81
- ; 
- ;Integration Agreements
- ;----------------------
- ;INIT^HLFNC2(2161); GENACK^HLMA1(2165); $$DT^XLFDT(10103)
- ; 
+ ; 09/01/2006   Acomodate multiplr ORC/OBR segments Patch 81
 EN1 ; Build the ^TMP("RARPT-REC" global when we receive the
  ; 07/05/2006 Remedy Call 124379 message from HL7. If RAHLTCPB is defined, do not broadcast ORM messages. As of the writing
- ; of patch 71, RAHLTCPB is referenced in RAHLTCPB, UPSTAT^RAUTL0, & UP2^RAUTL1 Generic provider: RADIOLOGY,OUTSIDE SERVICE
- N RATELE,RATELENM,RATELEPI,RATELEKN,RATELEDR,RATELEDF
- D TELE^RAHLRPTT ;Patch 84
- ;** branch to new HL7 logic when the HL7 version surpasses 2.3 **
- I HL("VER")>2.3,($T(^RAHLTCPX))'="" GOTO EN1^RAHLTCPX
+ ; of patch 71, RAHLTCPB is referenced in RAHLTCPB, UPSTAT^RAUTL0, & UP2^RAUTL1
+ ;G:$G(HL("VER"))]"2.3" EN1^RAHLTCPX
  S RASUB=HL("MID"),RAHLTCPB=1 K RAERR
  ;**********************************************
@@ -68 +60 @@
  . S:$P(RADTCN,$E(HL("ECH")),2)]"" ^TMP(RARRR,$J,RASUB,"RALONGCN")=$P(RADTCN,$E(HL("ECH")),2)
  . Q
- I $G(RADTI)'>0 S RAERR="Invalid exam registration timestamp" D XIT Q
- I $G(RACNI)'>0 S RAERR="Invalid exam record IEN" D XIT Q
  S RAHLD=$$PCEXTR^RAHLO4(CNT,SEGMNT,25,HL("FS")) K RAHL70
  I RAHLD="" S RAERR="Missing Report Status" D XIT Q
- I "AFR"'[RAHLD S RAERR="Invalid Report Status: "_RAHLD D XIT Q
+ I "AFR"'[RAHLD S RAERR="Invalid Report Status" D XIT Q
  S ^TMP(RARRR,$J,RASUB,"RASTAT")=RAHLD
  G:$P(RARRR,"-",3) 112 S RAHLD=$$PCEXTR^RAHLO4(CNT,SEGMNT,32,HL("FS")) K RAHL70
@@ -82 +72 @@
  E  D  ; $D(^VA(200,"B",RAVERF)) true, get the entry ien
  . S RAVERF=$O(^VA(200,"B",RAVERF,0))
- . S:'RAVERF RAERR="Invalid Provider Name: "_RAHLD
+ . S:'RAVERF RAERR="Invalid Provider Name"
  ; can't get resident info from medspeak
  S RAHLD=$$PCEXTR^RAHLO4(CNT,SEGMNT,33,HL("FS")),RARSDNT="" K RAHL70
@@ -96 +86 @@
  I $D(RAERR) D XIT Q
  D ESIG^RAHLO3
- ;
  ;If last OBR set provider info to all OBRs
  K XX F I=1:1:RACN S XX=RARRR_"-"_I D:$D(^TMP(XX,$J,RASUB))
@@ -110 +99 @@
  . Q:SEGMNT?@("1"""_HL("FS")_"""."""_HL("FS")_"""")  ;Quit if OBX is something as:    OBX||||||||
  . I $P(SEGMNT,HL("FS"),3)']"" S RAERR="Missing Observation Identifier" Q
- . S OBXTYP=$P($P(SEGMNT,HL("FS"),3),$E(HL("ECH"))),OBXTYP=$E($P(OBXTYP,"&",2))
+ . S OBXTYP=$P(SEGMNT,HL("FS"),3),OBXTYP=$E(OBXTYP,$F(OBXTYP,"&"))
  . S OBX2CE=""
  . S:OBXTYP="" OBXTYP=" "
@@ -144 +133 @@
  S X=$P(SEGMNT,HL("FS"),5)
  I X["\S\"!(X["\R\")!(X["\E\")!(X["\T\") D FORMAT
- I $G(RATELE),$D(RATELEKN),X[RATELEKN S X=$P(X,RATELEKN,2),RATELENM=$P(X,"-"),RATELEPI=$TR($P(X,"-",2)," ","") ;SFVAMC/DAD/9-7-2007/Comment out the quit Q  ;Patch 84
  D PAR
  F J=0:0 S J=$O(^TMP("RARPT-HL7",$J,CNT,J)) Q:'J  S X1=^(J),X=$E(X1,1,125) D PAR I $L(X1)>125 S X=$E(X1,126,999) D PAR
  I X=""!(LIN'="") S L=999 D P2
  Q
- ;
+FORMAT ; Format report text for Escape Character delimited codes.
+ S Y=X N T,Q
+ I Y["\S\" S Q=$F(Y,"\S\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"))_$E(Y,Q,$L(X)),Y=X
+ I Y["\R\" S Q=$F(Y,"\R\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"),2)_$E(Y,Q,$L(X)),Y=X
+ I Y["\E\" S Q=$F(Y,"\E\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"),3)_$E(Y,Q,$L(X)),Y=X
+ I Y["\T\" S Q=$F(Y,"\T\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"),4)_$E(Y,Q,$L(X)),Y=X
+ I X["\S\"!(X["\R\")!(X["\E\")!(X["\T\") D FORMAT
+ Q
 PAR ; Build text paragraph
  S LIN=LIN_X
@@ -167 +162 @@
  S MSA1="AA"
  Q:$E($G(HL("SAN")),1,3)'="RA-"  ; Don't allow non RA namespaced interfaces
- I $D(RAERR) S MSA1=$S($G(HL("SAN"))="RA-PSCRIBE-TCP"!$G(RATELE):"AE",1:"AR")
+ I $D(RAERR) S MSA1=$S($G(HL("SAN"))="RA-PSCRIBE-TCP":"AE",1:"AR")
  ; Added next line to support MedSpeak interface.  Must re-initialize
  ; FS and EC's before sending ACK.
@@ -176 +171 @@
  K HLRESLT D GENACK^HLMA1(HLEID,HLMTIENS,HLEIDS,HLARYTYP,HLFORMAT)
  Q
- ;
-FORMAT ; Format report text for Escape Character delimited codes.
- S Y=X N T,Q
- I Y["\S\" S Q=$F(Y,"\S\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"))_$E(Y,Q,$L(X)),Y=X
- I Y["\R\" S Q=$F(Y,"\R\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"),2)_$E(Y,Q,$L(X)),Y=X
- I Y["\E\" S Q=$F(Y,"\E\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"),3)_$E(Y,Q,$L(X)),Y=X
- I Y["\T\" S Q=$F(Y,"\T\"),T=Q-4,X=$E(Y,1,T)_$E(HL("ECH"),4)_$E(Y,Q,$L(X)),Y=X
- I X["\S\"!(X["\R\")!(X["\E\")!(X["\T\") D FORMAT
- Q
- ;