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

MAGDHOW1.m

Go to the documentation of this file.
  1. MAGDHOW1 ;WOIFO/PMK/DAC - Capture Consult/Procedure Request data ; Jul 26, 2022@07:38:34
  1. ;;3.0;IMAGING;**138,174,180,210,208,292,323**;Mar 19, 2002;Build 8
  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. ;
  1. ; Supported IA #10006 reference ^DIC routine call
  1. ; Supported IA #2056 reference $$GET1^DIQ function call
  1. ; Supported IA #10103 reference $$NOW^XLFDT function call
  1. ; Controlled IA #4110 to read REQUEST/CONSULTATION file (#123)
  1. ; Supported IA #6925 to read HLO SUBSCRIPTION REGISTRY (#779.4)
  1. ;
  1. MSGSETUP(GMRCIEN,SERVICE,ORC1,ORC5,APTSCHED) ; called by ^MAGDHOWC and ^MAGDHOWS
  1. ; setup to send a message, if required
  1. N CONSULT,CPTIEN,DATETIME,DIVISION,FMDATE,FMDATETM
  1. N HL7SUBLIST,I,ITYPCODE,ITYPNAME,MSGTYPE,OBXSEGNO
  1. N ORCTRL,ORSTATUS,ORIGSERV,PARMS,SEGMENT,SENDIT,X,Y,Z
  1. ;
  1. S FMDATETM=$$NOW^XLFDT(),FMDATE=FMDATETM\1
  1. S MSGTYPE="ORM" ; HL7 message type for orders
  1. ;
  1. ; decide if service is one that requires HL7->DICOM gateway and PACS
  1. ;
  1. S SENDIT=$$SERVICE(SERVICE,GMRCIEN,.DIVISION,.ITYPNAME,.ITYPCODE,.CPTIEN,.HL7SUBLIST)
  1. ;
  1. I SENDIT D ; send this transaction via HL7 to DICOM gateway and PACS
  1. . ; check for an "OK" order control value which indicates a new order
  1. . I ORC1="OK" D
  1. . . S ORCTRL="NW" ; order control
  1. . . S ORSTATUS="IP" ; order status
  1. . . Q
  1. . ;
  1. . ; check for a cancelled or discontinued request
  1. . E I " CA CR DR OC OD "[(" "_ORC1_" ") D
  1. . . ; P210 DAC - Instead of Killing FILLER2, it will now be set to cancelled
  1. . . S FILLER2="GMRC-CANCELLED"
  1. . . S ORCTRL="CA" ; order control
  1. . . S ORSTATUS="CA" ; order status
  1. . . Q
  1. . ;
  1. . ; check for scheduled request (set in ^MAGDHOWS)
  1. . E I ORC1="XO",ORC5="SC" D
  1. . . S ORCTRL="XO" ; order control
  1. . . S ORSTATUS="SC" ; order status
  1. . . Q
  1. . ;
  1. . ; look for a result message
  1. . E I ORC1="RE" D ; result
  1. . . S MSGTYPE="ORU" ; HL7 message type for results
  1. . . ;
  1. . . I (ORC5="A")!($$UNSIGNED^MAGDGMRC(GMRCIEN)) D ; P180 DAC - Process unsigned TIU notes
  1. . . . S FILLER2="GMRC-NEW UNSIGNED RESULT"
  1. . . . S ORCTRL="RE" ; order control
  1. . . . S ORSTATUS="A" ; order status
  1. . . . Q
  1. . . E D ; new signed TIU note
  1. . . . K FILLER2 ; P174 DAC - remove any preset status like GMRC-SCHEDULED set in CHECKAPT^MAGDHOWC
  1. . . . S ORCTRL="RE" ; order control
  1. . . . S ORSTATUS="CM" ; order status
  1. . . . Q
  1. . . Q
  1. . ;
  1. . E D ; default
  1. . . S ORCTRL="SC" ; order control
  1. . . S ORSTATUS="IP" ; order status
  1. . . Q
  1. . D MESSAGE^MAGDHOW2(SERVICE)
  1. . Q
  1. ;
  1. I ORC1="RE" D ; do this for all consult results
  1. . ; link any outstanding DICOM images to the new TIU note
  1. . S I=$$NEWTIU^MAGDHOW0(GMRCIEN)
  1. . Q
  1. ;
  1. Q
  1. ;
  1. SERVICE(SERVICE,GMRCIEN,DIVISION,ITYPNAME,ITYPCODE,CPTIEN,HL7SUBLIST) ;
  1. ; check if the service is in the DICOM Clinical Service dictionary, and
  1. ; if so, then get all of the attributes
  1. N MWLCONFIG,SENDIT,X,Y,Z
  1. S (DIVISION,ITYPNAME,ITYPCODE,CPTIEN,HL7SUBLIST,SENDIT)=0
  1. I SERVICE D ; ignore SERVICE if it is null
  1. . S MWLCONFIG=$$MWLFIND(SERVICE,GMRCIEN)
  1. . S DIVISION=""
  1. . I MWLCONFIG D ; send order
  1. . . S X=$G(^MAG(2006.5831,MWLCONFIG,0))
  1. . . S DIVISION=$P(X,"^",5),CPTIEN=$P(X,"^",6),HL7SUBLIST=$P(X,"^",7)
  1. . . I HL7SUBLIST,$$GET1^DIQ(779.4,HL7SUBLIST,.01)="" S HL7SUBLIST=0 ; absent
  1. . . I 'HL7SUBLIST D ; lookup default HL7 subscription list
  1. . . . N DIC,DO,X,Y
  1. . . . S DIC=779.4,DIC(0)="BX",X="MAGD DEFAULT" D ^DIC
  1. . . . S HL7SUBLIST=$P(Y,"^",1) ; Y should equal "<ien>^MAGD DEFAULT"
  1. . . . Q
  1. . . ; get specialty index and procedure index (if available, otherwise, use 0)
  1. . . S Y=$P(X,"^",3)
  1. . . S ITYPNAME=$P(^MAG(2005.84,Y,0),"^",1)
  1. . . S ITYPCODE=$P($G(^MAG(2005.84,Y,2)),"^",1) ; P323 JCH - Fix undefined abbreviation issue
  1. . . S Z=$P(X,"^",4)
  1. . . I Z D ; get procedure name and code
  1. . . . S ITYPNAME=ITYPNAME_" -- "_$P(^MAG(2005.85,Z,0),"^",1)
  1. . . . S ITYPCODE=ITYPCODE_"/"_$P($G(^MAG(2005.85,Z,2)),"^",1) ; P292 DAC - Fix undefined abbreviation issue
  1. . . . Q
  1. . . S SENDIT=1
  1. . . Q
  1. . Q
  1. Q SENDIT
  1. ;
  1. MWLFIND(SERVICE,GMRCIEN) ; lookup 2006.5831 entry by service and procedure
  1. ; ordering a procedure and the 2006.5831 procedure entry are optional
  1. N PROCEDURE
  1. S PROCEDURE=+$$GET1^DIQ(123,GMRCIEN,4,"I")
  1. Q $$IREQUEST(SERVICE,PROCEDURE) ; pointer to modality worklist dictionary file #2006.5831
  1. ;
  1. IREQUEST(SERVICE,PROCEDURE) ; return the IEN of the consult or procedure for the request service
  1. N IEN,LIST
  1. ;
  1. S SERVICE=$G(SERVICE) I 'SERVICE Q 0
  1. ;
  1. ; if this is a lookup for a procedure, just return the "C" cross reference
  1. S PROCEDURE=$G(PROCEDURE)
  1. I PROCEDURE Q $O(^MAG(2006.5831,"C",SERVICE,PROCEDURE,""))
  1. ;
  1. ; use the "B" cross reference to make a list of all IENs for the request service
  1. S IEN="" F S IEN=$O(^MAG(2006.5831,"B",SERVICE,IEN)) Q:IEN="" S LIST(IEN)=""
  1. ;
  1. ; use the "C" cross reference to delete the IENs for the procedures
  1. S PROCEDURE="" F S PROCEDURE=$O(^MAG(2006.5831,"C",SERVICE,PROCEDURE)) Q:PROCEDURE="" D
  1. . S IEN=$O(^MAG(2006.5831,"C",SERVICE,PROCEDURE,""))
  1. . K LIST(IEN) ; remove the procedures from the list
  1. . Q
  1. ;
  1. ; return what is left in the list, which should be the consult, if there is one
  1. Q $O(LIST(""))