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