Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAIPST5

RAIPST5.m

Go to the documentation of this file.
  1. RAIPST5 ;HIRMFO/GJC - Post-init number five ;11/23/97 13:23
  1. VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
  1. ;
  1. PRO101 ; Add the following protocols to file 101 iff they are new
  1. ; to the Protocol (101) file: RA EXAMINED, RA RECEIVE, RA REG & RA RPT.
  1. ; RA SEND ORM, RA SEND ORU, RA CANCEL & RA EVSEND OR handled in RAIPST6
  1. ; Updates in accordance with DBIA: 872
  1. ; Note: The third subscript of RAFDA is the field number in file 101.
  1. ; Consult a data dictionary for further information.
  1. D EN1^RAIPST6 ; code for 'RA SEND ORM' & 'RA SEND ORU'. These need to
  1. ; be added first because the following protocols have the above
  1. ; designated as Items: RA CANCEL, RA EXAMINED, RA REG & RA RPT.
  1. ; After 'RA SEND ORM' & 'RA SEND ORU' are added in RAIPST6, we also
  1. ; add 'RA CANCEL' & 'RA EVSEND OR' in RAIPST6.
  1. EXAMINE ; RA EXAMINED protocol
  1. I '$D(^ORD(101,"B","RA EXAMINED")) D
  1. . N RA101,RAFDA
  1. . S RAFDA(101,"+1,",.01)="RA EXAMINED"
  1. . S RAFDA(101,"+1,",1)="Rad/Nuc Med examined case"
  1. . S RAFDA(101,"+1,",12)=$$PKG()
  1. . S RAFDA(101,"+1,",4)="event driver"
  1. . S RAFDA(101.01,"+2,+1,",.01)="RA SEND ORM"
  1. . S RAFDA(101,"+1,",20)="Q"
  1. . S RAFDA(101,"+1,",770.3)="ORM"
  1. . S RAFDA(101,"+1,",770.6)=$$PROID()
  1. . S RAFDA(101,"+1,",772)="Q"
  1. . S RAFDA(101,"+1,",99)=$$TSTMP()
  1. . S RAFDA(101,"+1,",770.4)="O01"
  1. . D MSG("RA EXAMINED")
  1. . D UPDATE^DIE("E","RAFDA")
  1. . I $D(^ORD(101,"B","RA EXAMINED")) D Q
  1. .. S RA101=$O(^ORD(101,"B","RA EXAMINED",0))
  1. .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
  1. .. S ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine exam"
  1. .. S ^ORD(101,RA101,1,2,0)="has reached a status where GENERATE EXAMINED HL7 MSG is Y"
  1. .. S ^ORD(101,RA101,1,3,0)="at that (or at a lower) status."
  1. .. S ^ORD(101,RA101,1,4,0)="This message contains all relevant information about the exam,"
  1. .. S ^ORD(101,RA101,1,5,0)="including procedure, time of registration, procedure modifiers,"
  1. .. S ^ORD(101,RA101,1,6,0)="patient allergies, and clinical history."
  1. .. S ^ORD(101,RA101,1,0)="^^6^6^"_$$DT^XLFDT()_"^^^"
  1. .. Q
  1. . D ERR("RA EXAMINED")
  1. . Q
  1. RECEIVE ; RA RECEIVE protocol
  1. I '$D(^ORD(101,"B","RA RECEIVE")) D
  1. . N RA101,RAFDA
  1. . ; no description for this protocol
  1. . S RAFDA(101,"+1,",.01)="RA RECEIVE"
  1. . S RAFDA(101,"+1,",1)="Rad/NM receives order msg from OE/RR"
  1. . S RAFDA(101,"+1,",12)=$$PKG()
  1. . S RAFDA(101,"+1,",4)="action"
  1. . S RAFDA(101,"+1,",20)="D EN1^RAO7RO(.XQORMSG)"
  1. . S RAFDA(101,"+1,",99)=$$TSTMP()
  1. . D MSG("RA RECEIVE")
  1. . D UPDATE^DIE("E","RAFDA")
  1. . Q
  1. REG ; RA REG protocol
  1. I '$D(^ORD(101,"B","RA REG")) D
  1. . N RA101,RAFDA
  1. . S RAFDA(101,"+1,",.01)="RA REG"
  1. . S RAFDA(101,"+1,",1)="Rad/Nuc Med exam registered"
  1. . S RAFDA(101,"+1,",12)=$$PKG()
  1. . S RAFDA(101,"+1,",4)="event driver"
  1. . S RAFDA(101.01,"+2,+1,",.01)="RA SEND ORM"
  1. . S RAFDA(101,"+1,",20)="Q"
  1. . S RAFDA(101,"+1,",770.3)="ORM"
  1. . S RAFDA(101,"+1,",770.6)=$$PROID()
  1. . S RAFDA(101,"+1,",772)="Q"
  1. . S RAFDA(101,"+1,",99)=$$TSTMP()
  1. . S RAFDA(101,"+1,",770.4)="O01"
  1. . D MSG("RA REG")
  1. . D UPDATE^DIE("E","RAFDA")
  1. . I $D(^ORD(101,"B","RA REG")) D Q
  1. .. S RA101=$O(^ORD(101,"B","RA REG",0))
  1. .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
  1. .. S ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine exam is"
  1. .. S ^ORD(101,RA101,1,2,0)="registered. It executes code that creates an HL7 ORM message consisting"
  1. .. S ^ORD(101,RA101,1,3,0)="of PID, ORC, OBR and OBX segments. The message contains all relevant"
  1. .. S ^ORD(101,RA101,1,4,0)="information about the exam, including procedure, time of registration,"
  1. .. S ^ORD(101,RA101,1,5,0)="procedure modifiers, patient allergies, and clinical history."
  1. .. S ^ORD(101,RA101,1,0)="^^5^5^"_$$DT^XLFDT()_"^^^^"
  1. .. Q
  1. . D ERR("RA REG")
  1. . Q
  1. RPT ; RA RPT protocol
  1. I '$D(^ORD(101,"B","RA RPT")) D
  1. . N RA101,RAFDA
  1. . S RAFDA(101,"+1,",.01)="RA RPT"
  1. . S RAFDA(101,"+1,",1)="Rad/Nuc Med report released/verified"
  1. . S RAFDA(101,"+1,",12)=$$PKG()
  1. . S RAFDA(101,"+1,",4)="event driver"
  1. . S RAFDA(101.01,"+2,+1,",.01)="RA SEND ORU"
  1. . S RAFDA(101,"+1,",20)="Q"
  1. . S RAFDA(101,"+1,",770.3)="ORU"
  1. . S RAFDA(101,"+1,",770.6)=$$PROID()
  1. . S RAFDA(101,"+1,",772)="Q"
  1. . S RAFDA(101,"+1,",99)=$$TSTMP()
  1. . S RAFDA(101,"+1,",770.4)="R01"
  1. . D MSG("RA RPT")
  1. . D UPDATE^DIE("E","RAFDA")
  1. . I $D(^ORD(101,"B","RA RPT")) D Q
  1. .. S RA101=$O(^ORD(101,"B","RA RPT",0))
  1. .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
  1. .. S ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine report"
  1. .. S ^ORD(101,RA101,1,2,0)="enters into a status of Verified or Released/Not Verified. It executes"
  1. .. S ^ORD(101,RA101,1,3,0)="code that creates an HL7 ORU message consisting of PID, OBR and OBX"
  1. .. S ^ORD(101,RA101,1,4,0)="segments. The message contains relevant information about the report,"
  1. .. S ^ORD(101,RA101,1,5,0)="including procedure, procedure modifiers, diagnostic code, interpreting"
  1. .. S ^ORD(101,RA101,1,6,0)="physician, impression text and report text."
  1. .. S ^ORD(101,RA101,1,0)="^^6^6^"_$$DT^XLFDT()_"^^"
  1. .. Q
  1. . D ERR("RA RPT")
  1. . Q
  1. Q
  1. ERR(X) ; Display an error message if the protocol does not get filed into 101.
  1. N TXT S TXT(1)="",TXT(2)="Protocol: '"_X_"' was not filed."
  1. S TXT(3)="IRM should investigate." D MES^XPDUTL(.TXT)
  1. Q
  1. MSG(X) ; Display to the user the protocol being added to file 101
  1. N RATXT S RATXT(1)=" ",RATXT(2)="Adding '"_X_"' to the protocol file."
  1. D MES^XPDUTL(.RATXT)
  1. Q
  1. PKG() ; Return the name of the package
  1. Q "RADIOLOGY/NUCLEAR MEDICINE"
  1. PROID() ; Return the Processing ID data
  1. Q "PRODUCTION"
  1. TSTMP() ; Timestamp the protocol entry with current date/time (in $H format)
  1. Q $$FMTH^XLFDT($$NOW^XLFDT())