source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAIPST5.m@ 1780

Last change on this file since 1780 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1RAIPST5 ;HIRMFO/GJC - Post-init number five ;11/23/97 13:23
2VERSION ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4PRO101 ; Add the following protocols to file 101 iff they are new
5 ; to the Protocol (101) file: RA EXAMINED, RA RECEIVE, RA REG & RA RPT.
6 ; RA SEND ORM, RA SEND ORU, RA CANCEL & RA EVSEND OR handled in RAIPST6
7 ; Updates in accordance with DBIA: 872
8 ; Note: The third subscript of RAFDA is the field number in file 101.
9 ; Consult a data dictionary for further information.
10 D EN1^RAIPST6 ; code for 'RA SEND ORM' & 'RA SEND ORU'. These need to
11 ; be added first because the following protocols have the above
12 ; designated as Items: RA CANCEL, RA EXAMINED, RA REG & RA RPT.
13 ; After 'RA SEND ORM' & 'RA SEND ORU' are added in RAIPST6, we also
14 ; add 'RA CANCEL' & 'RA EVSEND OR' in RAIPST6.
15EXAMINE ; RA EXAMINED protocol
16 I '$D(^ORD(101,"B","RA EXAMINED")) D
17 . N RA101,RAFDA
18 . S RAFDA(101,"+1,",.01)="RA EXAMINED"
19 . S RAFDA(101,"+1,",1)="Rad/Nuc Med examined case"
20 . S RAFDA(101,"+1,",12)=$$PKG()
21 . S RAFDA(101,"+1,",4)="event driver"
22 . S RAFDA(101.01,"+2,+1,",.01)="RA SEND ORM"
23 . S RAFDA(101,"+1,",20)="Q"
24 . S RAFDA(101,"+1,",770.3)="ORM"
25 . S RAFDA(101,"+1,",770.6)=$$PROID()
26 . S RAFDA(101,"+1,",772)="Q"
27 . S RAFDA(101,"+1,",99)=$$TSTMP()
28 . S RAFDA(101,"+1,",770.4)="O01"
29 . D MSG("RA EXAMINED")
30 . D UPDATE^DIE("E","RAFDA")
31 . I $D(^ORD(101,"B","RA EXAMINED")) D Q
32 .. S RA101=$O(^ORD(101,"B","RA EXAMINED",0))
33 .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
34 .. S ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine exam"
35 .. S ^ORD(101,RA101,1,2,0)="has reached a status where GENERATE EXAMINED HL7 MSG is Y"
36 .. S ^ORD(101,RA101,1,3,0)="at that (or at a lower) status."
37 .. S ^ORD(101,RA101,1,4,0)="This message contains all relevant information about the exam,"
38 .. S ^ORD(101,RA101,1,5,0)="including procedure, time of registration, procedure modifiers,"
39 .. S ^ORD(101,RA101,1,6,0)="patient allergies, and clinical history."
40 .. S ^ORD(101,RA101,1,0)="^^6^6^"_$$DT^XLFDT()_"^^^"
41 .. Q
42 . D ERR("RA EXAMINED")
43 . Q
44RECEIVE ; RA RECEIVE protocol
45 I '$D(^ORD(101,"B","RA RECEIVE")) D
46 . N RA101,RAFDA
47 . ; no description for this protocol
48 . S RAFDA(101,"+1,",.01)="RA RECEIVE"
49 . S RAFDA(101,"+1,",1)="Rad/NM receives order msg from OE/RR"
50 . S RAFDA(101,"+1,",12)=$$PKG()
51 . S RAFDA(101,"+1,",4)="action"
52 . S RAFDA(101,"+1,",20)="D EN1^RAO7RO(.XQORMSG)"
53 . S RAFDA(101,"+1,",99)=$$TSTMP()
54 . D MSG("RA RECEIVE")
55 . D UPDATE^DIE("E","RAFDA")
56 . Q
57REG ; RA REG protocol
58 I '$D(^ORD(101,"B","RA REG")) D
59 . N RA101,RAFDA
60 . S RAFDA(101,"+1,",.01)="RA REG"
61 . S RAFDA(101,"+1,",1)="Rad/Nuc Med exam registered"
62 . S RAFDA(101,"+1,",12)=$$PKG()
63 . S RAFDA(101,"+1,",4)="event driver"
64 . S RAFDA(101.01,"+2,+1,",.01)="RA SEND ORM"
65 . S RAFDA(101,"+1,",20)="Q"
66 . S RAFDA(101,"+1,",770.3)="ORM"
67 . S RAFDA(101,"+1,",770.6)=$$PROID()
68 . S RAFDA(101,"+1,",772)="Q"
69 . S RAFDA(101,"+1,",99)=$$TSTMP()
70 . S RAFDA(101,"+1,",770.4)="O01"
71 . D MSG("RA REG")
72 . D UPDATE^DIE("E","RAFDA")
73 . I $D(^ORD(101,"B","RA REG")) D Q
74 .. S RA101=$O(^ORD(101,"B","RA REG",0))
75 .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
76 .. S ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine exam is"
77 .. S ^ORD(101,RA101,1,2,0)="registered. It executes code that creates an HL7 ORM message consisting"
78 .. S ^ORD(101,RA101,1,3,0)="of PID, ORC, OBR and OBX segments. The message contains all relevant"
79 .. S ^ORD(101,RA101,1,4,0)="information about the exam, including procedure, time of registration,"
80 .. S ^ORD(101,RA101,1,5,0)="procedure modifiers, patient allergies, and clinical history."
81 .. S ^ORD(101,RA101,1,0)="^^5^5^"_$$DT^XLFDT()_"^^^^"
82 .. Q
83 . D ERR("RA REG")
84 . Q
85RPT ; RA RPT protocol
86 I '$D(^ORD(101,"B","RA RPT")) D
87 . N RA101,RAFDA
88 . S RAFDA(101,"+1,",.01)="RA RPT"
89 . S RAFDA(101,"+1,",1)="Rad/Nuc Med report released/verified"
90 . S RAFDA(101,"+1,",12)=$$PKG()
91 . S RAFDA(101,"+1,",4)="event driver"
92 . S RAFDA(101.01,"+2,+1,",.01)="RA SEND ORU"
93 . S RAFDA(101,"+1,",20)="Q"
94 . S RAFDA(101,"+1,",770.3)="ORU"
95 . S RAFDA(101,"+1,",770.6)=$$PROID()
96 . S RAFDA(101,"+1,",772)="Q"
97 . S RAFDA(101,"+1,",99)=$$TSTMP()
98 . S RAFDA(101,"+1,",770.4)="R01"
99 . D MSG("RA RPT")
100 . D UPDATE^DIE("E","RAFDA")
101 . I $D(^ORD(101,"B","RA RPT")) D Q
102 .. S RA101=$O(^ORD(101,"B","RA RPT",0))
103 .. K RAFDA S RAFDA(101,RA101_",",770.95)=2.1 D FILE^DIE("E","RAFDA")
104 .. S ^ORD(101,RA101,1,1,0)="This protocol is triggered whenever a Radiology/Nuclear Medicine report"
105 .. S ^ORD(101,RA101,1,2,0)="enters into a status of Verified or Released/Not Verified. It executes"
106 .. S ^ORD(101,RA101,1,3,0)="code that creates an HL7 ORU message consisting of PID, OBR and OBX"
107 .. S ^ORD(101,RA101,1,4,0)="segments. The message contains relevant information about the report,"
108 .. S ^ORD(101,RA101,1,5,0)="including procedure, procedure modifiers, diagnostic code, interpreting"
109 .. S ^ORD(101,RA101,1,6,0)="physician, impression text and report text."
110 .. S ^ORD(101,RA101,1,0)="^^6^6^"_$$DT^XLFDT()_"^^"
111 .. Q
112 . D ERR("RA RPT")
113 . Q
114 Q
115ERR(X) ; Display an error message if the protocol does not get filed into 101.
116 N TXT S TXT(1)="",TXT(2)="Protocol: '"_X_"' was not filed."
117 S TXT(3)="IRM should investigate." D MES^XPDUTL(.TXT)
118 Q
119MSG(X) ; Display to the user the protocol being added to file 101
120 N RATXT S RATXT(1)=" ",RATXT(2)="Adding '"_X_"' to the protocol file."
121 D MES^XPDUTL(.RATXT)
122 Q
123PKG() ; Return the name of the package
124 Q "RADIOLOGY/NUCLEAR MEDICINE"
125PROID() ; Return the Processing ID data
126 Q "PRODUCTION"
127TSTMP() ; Timestamp the protocol entry with current date/time (in $H format)
128 Q $$FMTH^XLFDT($$NOW^XLFDT())
Note: See TracBrowser for help on using the repository browser.