Changeset 636 for FOIAVistA/tag/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRPC.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/RAHLRPC.m (modified) (4 diffs)

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

@@ -1 +1 @@
 RAHLRPC ;HIRMFO/BNT-Rad/NM HL7 Protocol calls ;05/21/99   14:50
- ;;5.0;Radiology/Nuclear Medicine;**12,25,54,71,82,81,84**;Mar 16, 1998;Build 13
+ ;;5.0;Radiology/Nuclear Medicine;**12,25,54,71,82,81**;Mar 16, 1998;Build 12
  ; 03/16/2006 *71 Rem Call 124379 allow exam updates to create HL7 msg
- ;
- ;Integration Agreements
- ;----------------------
- ;$$FIND1^DIC(2051); GETS^DIQ(2056)
- ;all access to ^ORD(101 to maintain application specific protocols(872)
- ;read w/FileMan HL7 APPLICATION PARAMETER(10136)
- ; 
 REG ; register exam
- N X,RA101Z,RAEID
- S RA101Z="RA REF" ; get all protocols beginning RA REG
- F  S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA REG"  D
- .S RAEID=$O(^ORD(101,"B",RA101Z,0))
+ N X,RAPID,RAEID
+ S RAPID="RA REF" ; get all protocols beginning RA REG
+ F  S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA REG"  D
+ .S RAEID=$O(^ORD(101,"B",RAPID,0))
  .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR
  Q
 CANCEL ; cancel exam
- N X,RA101Z,RAEID
- S RA101Z="RA CANCEK" ; get all protocols beginning RA CANCEL
- F  S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA CANCEL"  D
- .S RAEID=$O(^ORD(101,"B",RA101Z,0))
+ N X,RAPID,RAEID
+ S RAPID="RA CANCEK" ; get all protocols beginning RA CANCEL
+ F  S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA CANCEL"  D
+ .S RAEID=$O(^ORD(101,"B",RAPID,0))
  .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR
  Q
  ;
 RPT ; report verified or released/not verified
- N X,RA101Z,RAEID,RASSS ; RASSS subcriber array to be passed to HLL for GENERATE^HLMA
+ N X,RAPID,RAEID,RASSS ; RASSS subcriber array to be passed to HLL for GENERATE^HLMA
  ;S X="^%ET",@^%ZOSF("TRAP")
- S RA101Z="RA RPS" ; get all protocols beginning RA RPT
- F  S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA RPT"  D
- .S RAEID=$O(^ORD(101,"B",RA101Z,0)) K RASSS  ; RA*5*81
+ S RAPID="RA RPS" ; get all protocols beginning RA RPT
+ F  S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA RPT"  D
+ .S RAEID=$O(^ORD(101,"B",RAPID,0)) K RASSS  ; RA*5*81
  .S:$L($G(RANOSEND)) RAEID=$$GETEID(RAEID,RANOSEND,.RASSS) ;RA*5*81
  .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLRPT
@@ -51 +44 @@
  ; RAEXEDT = Indication of editing of: proc, proc mod, req phys, CPT mod, Tech comm...
  ; RAGENHL7 = Indication that sending ORU is due...
- ; RASSSX1(IENs) = Array of subscribers from 771, the message will be sent (SCIMGE)
  ; 
- N RAIMGTYI,RAIMGTYJ,RALOWER,RANEWST,RAEXMDUN,RAGENHL7,RASSSX1
+ N RAIMGTYI,RAIMGTYJ,RALOWER,RANEWST,RAEXMDUN,RAGENHL7
  S RAIMGTYI=$P($G(^RADPT(RADFN,"DT",RADTI,0)),U,2),RAIMGTYJ=$P(^RA(79.2,RAIMGTYI,0),U),RANEWST=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),U,3)
  S:$P(^RA(72,RANEWST,0),U,8)="Y" RAGENHL7=1 ;this status has GEN HL7 marked Y
@@ -61 +53 @@
  ;?? none of the lower status levels have GEN HL7 marked Y
  K:$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,30)="Y" RAGENHL7 ;already sent
- ;Q:'$G(RAEXEDT)&'$G(RAGENHL7)
- ; Business Rule: RA*5*84 sends an examined message to ScImage unconditionally
- I '$G(RAEXEDT),'$G(RAGENHL7) Q:'$O(^RA(79.7,0))  D  Q:'$O(RASSSX1(0))
- .N X,RASSS,RASSSL S X=0 F  S X=$O(^RA(79.7,X)) Q:'X  S:$P(^(X,0),U,2) RASSS(X)=""
- .D:$D(RASSS) GETSUB^RAHLRS1(.RASSS,.RASSSX1,.RASSSL)
+ Q:'$G(RAEXEDT)&'$G(RAGENHL7)
+ ;
 1 N RAEXMDUN
  S RAEXMDUN=1
-A1 N X,RA101Z,RAEID
- S RA101Z="RA EXAMINEC" ; get all protocols beginning RA EXAMINED
- F  S RA101Z=$O(^ORD(101,"B",RA101Z)) Q:RA101Z'["RA EXAMINED"  D
- .N RAGENHL7 S RAEID=$O(^ORD(101,"B",RA101Z,0))
+A1 N X,RAPID,RAEID
+ S RAPID="RA EXAMINEC" ; get all protocols beginning RA EXAMINED
+ F  S RAPID=$O(^ORD(101,"B",RAPID)) Q:RAPID'["RA EXAMINED"  D
+ .N RAGENHL7 S RAEID=$O(^ORD(101,"B",RAPID,0))
  .I RAEID,'$L($P(^ORD(101,RAEID,0),"^",3)) D EN^RAHLR
  S:$G(RAGENHL7) $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,30)="Y"
@@ -82 +71 @@
  ; 0 (zero) returned if No subscriber exist or all subscribers associated with RANOSEND application.
  S RAEID=$G(RAEID) Q:'RAEID!'$L($G(RANOSEND))!'$D(^ORD(101,+RAEID,0)) RAEID
- N RAXX,ERR,X1,Y1,YY,RAPL,RANEW,RAPIDS,RAIEDS,DIERR,RAERR
- S RAPL=$S(+RANOSEND:+RANOSEND,1:$$FIND1^DIC(771,"","X",RANOSEND,"","","RAERR"))
- Q:'RAPL!($D(RAERR)#2) RAEID
+ N RAXX,ERR,X1,Y1,YY,RAPL,RANEW,RAPIDS,RAIEDS
+ S RAPL=$S(+RANOSEND:+RANOSEND,1:$O(^HL(771,"B",RANOSEND,0))) Q:'RAPL RAEID
  D GETS^DIQ(101,RAEID_",","**","I","RAXX","ERR")
  Q:$D(ERR) RAEID ; Was not able get Event driver info... so just pass event driver...