| 1 | MAGDTR01 ;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 | ;;
|
|---|
| 18 | ENTRY ; 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 | ;
|
|---|
| 50 | ORRIN ; 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 | ;
|
|---|
| 56 | ORRINER1 ; 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 | ;
|
|---|
| 63 | ORRINER2 ; Unwind
|
|---|
| 64 | I $ST>MAGETLVL Q:$Q "" Q
|
|---|
| 65 | S $EC=""
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | ORRINPRC ;
|
|---|
| 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 | ;
|
|---|
| 99 | GETHL7A(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 | ;
|
|---|
| 118 | GETHL7B(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 | ;
|
|---|
| 147 | GETHL7 ; 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 | ;
|
|---|
| 165 | FINDLIST(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 | ;
|
|---|
