Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDTR01

MAGDTR01.m

Go to the documentation of this file. 
  1. MAGDTR01 ;WOIFO/PMK/NST - Unread List for Consult/Procedure Request ; 12 Apr 2012  1:24 AM
  1.  ;;3.0;IMAGING;**46,127**;Mar 19, 2002;Build 4231;Apr 01, 2013
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1. ENTRY ; entry point from ^MAGDHWC for a consult request
  1.  N GMRCSTS ;-- GMRC request status
  1.  N RESULT ;--- scratch variable
  1.  ;
  1.  ; check for an "OK" order control value in the ORC segment
  1.  I $P(HL7ORC,DEL)="OK" D  Q  ; new order
  1.  . D ADD^MAGDTR03(.RESULT,GMRCIEN,"O") ; add if "on order" is set
  1.  . Q
  1.  ;
  1.  ; check for a discontinued order
  1.  I " CA CR DC DR OC OD "[(" "_$P(HL7ORC,DEL)_" ") D  Q
  1.  . D CANCEL^MAGDTR03 ; record the order as cancelled
  1.  . Q
  1.  ;
  1.  ; check for a FORWARD in the ORC segment
  1.  I $P($P(HL7ORC,DEL,16),DEL2,5)="FORWARD" D  Q
  1.  . D FORWARD^MAGDTR02 ; handle forward for Unread List
  1.  . Q
  1.  ;
  1.  ; drive it off the GMRC request status
  1.  S GMRCSTS=$$GET1^DIQ(123,GMRCIEN,8)
  1.  I (GMRCSTS="PENDING")!(GMRCSTS="ACTIVE") D  Q
  1.  . D ADD^MAGDTR03(.RESULT,GMRCIEN,"O") ; add if "on order" is set
  1.  . Q
  1.  I GMRCSTS="COMPLETE" D  Q
  1.  . D COMPLETE^MAGDTR03 ; tag study as completed
  1.  . Q
  1.  I (GMRCSTS="CANCELLED")!(GMRCSTS="DISCONTINUED") D  Q
  1.  . D CANCEL^MAGDTR03 ; tag study as cancelled
  1.  . Q
  1.  Q
  1.  ;
  1. ORRIN ; entry point for processing IFC responses
  1.  N MAGETLVL,$ET
  1.  S $ET="D ORRINER1^"_$T(+0),MAGETLVL=$ST+1
  1.  D ORRINPRC
  1.  Q
  1.  ;
  1. ORRINER1 ; Log the error
  1.  D ^%ZTER
  1.  S $ET="D ORRINER2^"_$T(+0)
  1.  I $ST>MAGETLVL Q:$Q "" Q
  1.  S $EC=""
  1.  Q
  1.  ;
  1. ORRINER2 ; Unwind
  1.  I $ST>MAGETLVL Q:$Q "" Q
  1.  S $EC=""
  1.  Q
  1.  ;
  1. ORRINPRC ;
  1.  ; this is "piggy-backed" onto the GMRC IFC ORM EVENT protocol
  1.  ; see the RESPONSE PROCESSING ROUTINE for this protocol
  1.  ; the HL7 event handler first invokes ORRIN^GMRCIMSG and then this
  1.  ;
  1.  N GMRCIEN ;-- IEN of consult
  1.  N ORDCTRL ;-- order control code from ORC segment
  1.  N UNREAD ;--- IEN of entry on ^MAG(2006.5849)
  1.  N TIMESTMP ;- FileMan time stamp of unread item
  1.  N LISTDATA ;- unread list info from ^MAG(2006.5849)
  1.  N ACQSITE ;-- acquisition site
  1.  N IPROCIDX ;- procedure index
  1.  N ISPECIDX ;- specialty index
  1.  ;
  1.  D GETHL7A^MAGDTR01(.ORDCTRL,.GMRCIEN) Q:ORDCTRL'="OK"
  1.  Q:'$$FINDLIST^MAGDTR01(GMRCIEN)  ; not in unread list
  1.  S UNREAD=$$UNREAD^MAGDTR02(GMRCIEN) Q:'UNREAD   ; not there yet
  1.  S TIMESTMP=$$TIMESTMP^MAGDTR02(UNREAD) ; update the timestamp
  1.  S LISTDATA=^MAG(2006.5849,UNREAD,0)
  1.  ; record time of IFC response
  1.  S:$P(LISTDATA,"^",6)="" $P(^MAG(2006.5849,UNREAD,0),"^",6)=TIMESTMP
  1.  ; now change status to "Unread", if it was a "Waiting" previously
  1.  I $P(LISTDATA,"^",11)="W" D  ; switch status and update cross reference
  1.  . S $P(^MAG(2006.5849,UNREAD,0),"^",11)="U"
  1.  . S ACQSITE=$P(LISTDATA,"^",2),ISPECIDX=$P(LISTDATA,"^",3)
  1.  . S IPROCIDX=$P(LISTDATA,"^",4)
  1.  . K ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,"W",UNREAD)
  1.  . S ^MAG(2006.5849,"D",ACQSITE,ISPECIDX,IPROCIDX,"U",UNREAD)=""
  1.  . Q
  1.  Q
  1.  ;
  1. GETHL7A(STATUS,GMRCIEN) ; get data from HL7 message - called from above
  1.  ; input:  none
  1.  ; output:  PERSON     name of person ordering the consult
  1.  ;          LOCATION   IEN of the location from which the consult is ordered
  1.  ;
  1.  N HL7PARSE ;- name of parsed HL7 array defined by GETHL7
  1.  N HL7RAW ;--- name of raw HL7 array defined by GETHL7
  1.  N HL7SEGNO ;- segment number index returned by $$GETSEG^MAGDHRC0
  1.  ;
  1.  D GETHL7
  1.  S (STATUS,GMRCIEN)=""
  1.  S HL7SEGNO=$$GETSEG^MAGDHRC0("ORC")
  1.  I HL7SEGNO D
  1.  . S STATUS=$$GETDATA^MAGDHRC0(1)
  1.  . S GMRCIEN=$$GETDATA^MAGDHRC0(2,1,1)
  1.  . Q
  1.  K @HL7PARSE
  1.  Q
  1.  ;
  1. GETHL7B(PERSON,LOCATION) ; get data from HL7 message - call from ^MAGDTR03
  1.  ; input:  none
  1.  ; output:  PERSON     name of person ordering the consult
  1.  ;          LOCATION   IEN of the location from which the consult is ordered
  1.  ;
  1.  N HL7PARSE ;- name of parsed HL7 array defined by GETHL7
  1.  N HL7RAW ;--- name of raw HL7 array defined by GETHL7
  1.  N HL7SEGNO ;- segment number index returned by $$GETSEG^MAGDHRC0
  1.  N IPERSON ;-- field number in ORC segment that contains responsible/entered-by person
  1.  ;
  1.  D GETHL7
  1.  K PERSON S LOCATION=""
  1.  S HL7SEGNO=$$GETSEG^MAGDHRC0("ORC")
  1.  ; get "responsible person" from ORC-12 or "entered by" person from ORC-10
  1.  S IPERSON=$S($$GETDATA^MAGDHRC0(12)="":10,1:12)
  1.  S PERSON("FAMILY")=$$GETDATA^MAGDHRC0(IPERSON,1,1)
  1.  S PERSON("GIVEN")=$$GETDATA^MAGDHRC0(IPERSON,1,2)
  1.  S PERSON("MIDDLE")=$$GETDATA^MAGDHRC0(IPERSON,1,3)
  1.  S PERSON("SUFFIX")=$$GETDATA^MAGDHRC0(IPERSON,1,4)
  1.  S PERSON=PERSON("FAMILY")
  1.  I PERSON("GIVEN")'="" S PERSON=PERSON_","_PERSON("GIVEN")
  1.  I PERSON("MIDDLE")'="" S PERSON=PERSON_" "_PERSON("MIDDLE")
  1.  I PERSON("SUFFIX")'="" S PERSON=PERSON_" "_PERSON("SUFFIX")
  1.  ; location of the consult is in OBX-5.3(?)
  1.  S HL7SEGNO=$$GETSEG^MAGDHRC0("OBX")
  1.  S:HL7SEGNO LOCATION=$$IEN^XUAF4($$GETDATA^MAGDHRC0(5,1,3))
  1.  K @HL7PARSE
  1.  Q
  1.  ;
  1. GETHL7 ; get data from HL7 message
  1.  ; called from above and also called from ^MAGDTR03
  1.  ;
  1.  ; returns: HL7PARSE (name of parsed HL7 array)
  1.  ;          HL7RAW   (name of array of unparsed HL7 segments)
  1.  ;
  1.  N HLNODE ;--- a full HL7 segment returned by X HLNEXT
  1.  N I ;-------- scratch array index
  1.  N X ;-------- dummy status return from $$PARSE^MAG7UP
  1.  ;
  1.  S HL7PARSE=$NAME(^TMP("MAG",$J,"HL7","PARSED"))
  1.  S HL7RAW="HL7RAW"
  1.  K @HL7PARSE ; initialize the destination global
  1.  ; copy HL7 message from ^TMP to HL7RAW global array
  1.  F I=1:1 X HLNEXT Q:HLQUIT'>0  S @HL7RAW@(I)=HLNODE
  1.  S X=$$PARSE^MAG7UP(HL7RAW,HL7PARSE) ; build the parsed HL7 array
  1.  Q
  1.  ;
  1. FINDLIST(GMRCIEN,ISPECIDX,IPROCIDX,ACQSITE,TRIGGER,TIUNOTE,ALTSERV) ;
  1.  ; find the read/unread list for this consult
  1.  N CONSPROC,PROC,TOSERV,X,XREF
  1.  S (ISPECIDX,IPROCIDX,ACQSITE,TRIGGER,TIUNOTE)=""
  1.  Q:'$G(GMRCIEN) 0
  1.  S TOSERV=$G(ALTSERV) ; optional argument
  1.  I TOSERV="" S TOSERV=+$$GET1^DIQ(123,GMRCIEN,1,"I")
  1.  S CONSPROC=$$GET1^DIQ(123,GMRCIEN,13,"I")
  1.  S PROC=$S(CONSPROC="C":"",1:$$GET1^DIQ(123,GMRCIEN,4,"I"))
  1.  S XREF=$O(^MAG(2006.5841,"AC",TOSERV,+PROC,""))
  1.  I 'XREF Q 0 ; no read/unread list
  1.  S X=$G(^MAG(2006.5841,XREF,0))
  1.  I X="" Q 0  ; record doesn't exist
  1.  S ISPECIDX=$P(X,"^",3),IPROCIDX=$P(X,"^",4),ACQSITE=$P(X,"^",5)
  1.  S TRIGGER=$P(X,"^",6),TIUNOTE=$P(X,"^",7)
  1.  Q XREF
  1.  ;