- 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 Jan 18, 2025@03:37:31 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())