source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGDTR01.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 6.7 KB
Line 
1MAGDTR01 ;WOIFO/PMK - Unread List for Consult/Procedure Request ; 20 Sep 2006 9:04 AM
2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18ENTRY ; entry point from ^MAGDHWC for a consult request
19 N GMRCSTS ;-- GMRC request status
20 N RESULT ;--- scratch variable
21 ;
22 ; check for an "OK" order control value in the ORC segment
23 I $P(HL7ORC,DEL)="OK" D Q ; new order
24 . D ADD^MAGDTR03(.RESULT,GMRCIEN,"O") ; add if "on order" is set
25 . Q
26 ;
27 ; check for a discontinued order
28 I " CA CR DC DR OC OD "[(" "_$P(HL7ORC,DEL)_" ") D Q
29 . D CANCEL^MAGDTR03 ; record the order as cancelled
30 . Q
31 ;
32 ; check for a FORWARD in the ORC segment
33 I $P($P(HL7ORC,DEL,16),DEL2,5)="FORWARD" D Q
34 . D FORWARD^MAGDTR02 ; handle forward for Unread List
35 . Q
36 ;
37 ; drive it off the GMRC request status
38 S GMRCSTS=$$GET1^DIQ(123,GMRCIEN,8)
39 I (GMRCSTS="PENDING")!(GMRCSTS="ACTIVE") D Q
40 . D ADD^MAGDTR03(.RESULT,GMRCIEN,"O") ; add if "on order" is set
41 . Q
42 I GMRCSTS="COMPLETE" D Q
43 . D COMPLETE^MAGDTR03 ; tag study as completed
44 . Q
45 I (GMRCSTS="CANCELLED")!(GMRCSTS="DISCONTINUED") D Q
46 . D CANCEL^MAGDTR03 ; tag study as cancelled
47 . Q
48 Q
49 ;
50ORRIN ; entry point for processing IFC responses
51 N MAGETLVL,$ET
52 S $ET="D ORRINER1^"_$T(+0),MAGETLVL=$ST+1
53 D ORRINPRC
54 Q
55 ;
56ORRINER1 ; Log the error
57 D ^%ZTER
58 S $ET="D ORRINER2^"_$T(+0)
59 I $ST>MAGETLVL Q:$Q "" Q
60 S $EC=""
61 Q
62 ;
63ORRINER2 ; Unwind
64 I $ST>MAGETLVL Q:$Q "" Q
65 S $EC=""
66 Q
67 ;
68ORRINPRC ;
69 ; this is "piggy-backed" onto the GMRC IFC ORM EVENT protocol
70 ; see the RESPONSE PROCESSING ROUTINE for this protocol
71 ; the HL7 event handler first invokes ORRIN^GMRCIMSG and then this
72 ;
73 N GMRCIEN ;-- IEN of consult
74 N ORDCTRL ;-- order control code from ORC segment
75 N UNREAD ;--- IEN of entry on ^MAG(2006.5849)
76 N TIMESTMP ;- FileMan time stamp of unread item
77 N LISTDATA ;- unread list info from ^MAG(2006.5849)
78 N ACQSITE ;-- acquisition site
79 N IPROCIDX ;- procedure index
80 N ISPECIDX ;- specialty index
81 ;
82 D GETHL7A^MAGDTR01(.ORDCTRL,.GMRCIEN) Q:ORDCTRL'="OK"
83 Q:'$$FINDLIST^MAGDTR01(GMRCIEN) ; not in unread list
84 S UNREAD=$$UNREAD^MAGDTR02(GMRCIEN) Q:'UNREAD ; not there yet
85 S TIMESTMP=$$TIMESTMP^MAGDTR02(UNREAD) ; update the timestamp
86 S LISTDATA=^MAG(2006.5849,UNREAD,0)
87 ; record time of IFC response
88 S:$P(LISTDATA,"^",6)="" $P(^MAG(2006.5849,UNREAD,0),"^",6)=TIMESTMP
89 ; now change status to "Unread", if it was a "Waiting" previously
90 I $P(LISTDATA,"^",11)="W" D ; switch status and update cross reference
91 . S $P(^MAG(2006.5849,UNREAD,0),"^",11)="U"
92 . S ACQSITE=$P(LISTDATA,"^",2),ISPECIDX=$P(LISTDATA,"^",3)
93 . S IPROCIDX=$P(LISTDATA,"^",4)
94 . K ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,"W",UNREAD)
95 . S ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,"U",UNREAD)=""
96 . Q
97 Q
98 ;
99GETHL7A(STATUS,GMRCIEN) ; get data from HL7 message - called from above
100 ; input: none
101 ; output: PERSON name of person ordering the consult
102 ; LOCATION IEN of the location from which the consult is ordered
103 ;
104 N HL7PARSE ;- name of parsed HL7 array defined by GETHL7
105 N HL7RAW ;--- name of raw HL7 array defined by GETHL7
106 N HL7SEGNO ;- segment number index returned by $$GETSEG^MAGDHRC0
107 ;
108 D GETHL7
109 S (STATUS,GMRCIEN)=""
110 S HL7SEGNO=$$GETSEG^MAGDHRC0("ORC")
111 I HL7SEGNO D
112 . S STATUS=$$GETDATA^MAGDHRC0(1)
113 . S GMRCIEN=$$GETDATA^MAGDHRC0(2,1,1)
114 . Q
115 K @HL7PARSE
116 Q
117 ;
118GETHL7B(PERSON,LOCATION) ; get data from HL7 message - call from ^MAGDTR03
119 ; input: none
120 ; output: PERSON name of person ordering the consult
121 ; LOCATION IEN of the location from which the consult is ordered
122 ;
123 N HL7PARSE ;- name of parsed HL7 array defined by GETHL7
124 N HL7RAW ;--- name of raw HL7 array defined by GETHL7
125 N HL7SEGNO ;- segment number index returned by $$GETSEG^MAGDHRC0
126 N IPERSON ;-- field number in ORC segment that contains responsible/entered-by person
127 ;
128 D GETHL7
129 K PERSON S LOCATION=""
130 S HL7SEGNO=$$GETSEG^MAGDHRC0("ORC")
131 ; get "responsible person" from ORC-12 or "entered by" person from ORC-10
132 S IPERSON=$S($$GETDATA^MAGDHRC0(12)="":10,1:12)
133 S PERSON("FAMILY")=$$GETDATA^MAGDHRC0(IPERSON,1,1)
134 S PERSON("GIVEN")=$$GETDATA^MAGDHRC0(IPERSON,1,2)
135 S PERSON("MIDDLE")=$$GETDATA^MAGDHRC0(IPERSON,1,3)
136 S PERSON("SUFFIX")=$$GETDATA^MAGDHRC0(IPERSON,1,4)
137 S PERSON=PERSON("FAMILY")
138 I PERSON("GIVEN")'="" S PERSON=PERSON_","_PERSON("GIVEN")
139 I PERSON("MIDDLE")'="" S PERSON=PERSON_" "_PERSON("MIDDLE")
140 I PERSON("SUFFIX")'="" S PERSON=PERSON_" "_PERSON("SUFFIX")
141 ; location of the consult is in OBX-5.3(?)
142 S HL7SEGNO=$$GETSEG^MAGDHRC0("OBX")
143 S:HL7SEGNO LOCATION=$$IEN^XUAF4($$GETDATA^MAGDHRC0(5,1,3))
144 K @HL7PARSE
145 Q
146 ;
147GETHL7 ; get data from HL7 message
148 ; called from above and also called from ^MAGDTR03
149 ;
150 ; returns: HL7PARSE (name of parsed HL7 array)
151 ; HL7RAW (name of array of unparsed HL7 segments)
152 ;
153 N HLNODE ;--- a full HL7 segment returned by X HLNEXT
154 N I ;-------- scratch array index
155 N X ;-------- dummy status return from $$PARSE^MAG7UP
156 ;
157 S HL7PARSE=$NAME(^TMP("MAG",$J,"HL7","PARSED"))
158 S HL7RAW="HL7RAW"
159 K @HL7PARSE ; initialize the destination global
160 ; copy HL7 message from ^TMP to HL7RAW global array
161 F I=1:1 X HLNEXT Q:HLQUIT'>0 S @HL7RAW@(I)=HLNODE
162 S X=$$PARSE^MAG7UP(HL7RAW,HL7PARSE) ; build the parsed HL7 array
163 Q
164 ;
165FINDLIST(GMRCIEN,ISPECIDX,IPROCIDX,ACQSITE,TRIGGER,TIUNOTE,ALTSERV) ;
166 ; find the read/unread list for this consult
167 N CONSPROC,PROC,TOSERV,X,XREF
168 S (ISPECIDX,IPROCIDX,ACQSITE,TRIGGER,TIUNOTE)=""
169 Q:'$G(GMRCIEN) 0
170 S TOSERV=$G(ALTSERV) ; optional argument
171 I TOSERV="" S TOSERV=+$$GET1^DIQ(123,GMRCIEN,1,"I")
172 S CONSPROC=$$GET1^DIQ(123,GMRCIEN,13,"I")
173 S PROC=$S(CONSPROC="C":"",1:$$GET1^DIQ(123,GMRCIEN,4,"I"))
174 S XREF=$O(^MAG(2006.5841,"AC",TOSERV,+PROC,""))
175 I 'XREF Q 0 ; no read/unread list
176 S X=$G(^MAG(2006.5841,XREF,0))
177 S ISPECIDX=$P(X,"^",3),IPROCIDX=$P(X,"^",4),ACQSITE=$P(X,"^",5)
178 S TRIGGER=$P(X,"^",6),TIUNOTE=$P(X,"^",7)
179 Q XREF
180 ;
Note: See TracBrowser for help on using the repository browser.