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

MAGUXRF.m

Go to the documentation of this file. 
  1. MAGUXRF ;WOIFO/SRR/SG/NST - Imaging MUMPS cross-references ; 29 Oct 2010 2:23 PM
  1.  ;;3.0;IMAGING;**51,93,106**;Mar 19, 2002;Build 2002;Feb 28, 2011
  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. SETACT D AC(1) Q
  1. KILLACT D AC(0) Q
  1.  ;
  1. AC(SETKIL) N ACTION,ROUTINE,TYPE
  1.  ; "AC" Cross Reference for OBJECT TYPE - ACTION subfile
  1.  ;  ^MAG(2005.02,"AC",OBJECT TYPE,ACTION)=OBJECT TYPE^ACTION ROUTINE
  1.  S TYPE=$P(^MAG(2005.02,DA(1),0),"^",1)
  1.  S ACTION=^MAG(2005.02,DA(1),1,DA,0)
  1.  S ROUTINE=$P(ACTION,".",2),ACTION=$P(ACTION,".",1)
  1.  S:SETKIL ^MAG(2005.02,"AC",TYPE,ACTION)=TYPE_"^"_ROUTINE
  1.  K:'SETKIL ^MAG(2005.02,"AC",TYPE,ACTION)
  1.  K MAGACT1,MAGMETH,MAG
  1.  Q
  1.  ;
  1. SETPX ; Set PACS switch on; check fields first
  1.  ; Write checks
  1.  S ^MAG(2006.1,"APACS")=1
  1.  Q
  1.  ;
  1. KILPX ; Stop PACS system
  1.  K ^MAG(2006.1,"APACS")
  1.  Q
  1.  ;
  1. SETPDPX ; Set P(atient) D(ate) PX(procedure)
  1.  D SET Q:PDT=""  Q:DFN=""
  1.  S ^MAG(2005,"APDPX",DFN,PDT,PX,DA)=""
  1.  Q
  1.  ;
  1. SET S X0=^MAG(2005,DA,0),X2=$G(^(2))
  1.  S PDT=$P(X2,U,5) I PDT="" S PDT=$P(X2,U) Q:PDT=""
  1.  S DFN=$P(X0,U,7) Q:DFN=""
  1.  ;
  1. 4 S PX=$P(X0,U,8) I PX="" S PX="OTHER"
  1.  Q
  1.  ;
  1. KILPDPX ; Kill
  1.  D SET Q:PDT=""  Q:DFN=""
  1.  K ^MAG(2005,"APDPX",DFN,PDT,PX,DA)
  1.  Q
  1.  ;
  1. SETPPXD ; #5:Set (patient=X=DFN); #6:PX(procedure); #15:DT(procedure date/time)
  1.  ; Xref for patient field#5=Patient name (in form of DFN)
  1.  ; ^MAG(2005,"APPXDT",X,PX,reverseDT)=""
  1.  N CDT,RDT,PX,ER
  1.  D SETUP Q:$D(ER)
  1.  S ^MAG(2005,"APPXDT",X,PX,RDT,DA)=""
  1.  S ^MAG(2005,"APDTPX",X,RDT,PX,DA)=""
  1.  Q
  1.  ;
  1. SETUP ; Set up for patient Xref's-for field #5l
  1.  S PX=$P(^MAG(2005,DA,0),U,8),CDT=$P($G(^(2)),U,5)
  1.  I CDT="" S ER=1 Q
  1.  I PX="" S ER=1 Q
  1.  S RDT=9999999.9999-CDT
  1.  Q
  1.  ;
  1. KILPPXD ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
  1.  N CDT,PX,RDT,ER
  1.  D SETUP Q:$D(ER)
  1.  K ^MAG(2005,"APPXDT",X,PX,RDT,DA)
  1.  K ^MAG(2005,"APDTPX",X,RDT,PX,DA)
  1.  Q
  1.  ;
  1. SETPPXD6 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
  1.  ;XREF FOR PROCEDURE,FIELD#6
  1.  N DFN,CDT,RDT,ER
  1.  D SETUP6 Q:$D(ER)
  1.  S ^MAG(2005,"APPXDT",DFN,X,RDT,DA)=""
  1.  S ^MAG(2005,"APDTPX",DFN,RDT,X,DA)=""
  1.  Q
  1.  ;
  1. SETUP6 ; Set up for procedure xref-field#6
  1.  S DFN=$P(^MAG(2005,DA,0),U,7),CDT=$P($G(^(2)),U,5)
  1.  I CDT="" S ER=1 Q
  1.  I DFN="" S ER=1 Q
  1.  S RDT=9999999.9999-CDT
  1.  Q
  1.  ;
  1. KILPPXD6 ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
  1.  N DFN,CDT,RDT,ER
  1.  D SETUP6 Q:$D(ER)
  1.  K ^MAG(2005,"APPXDT",DFN,X,RDT,DA)
  1.  K ^MAG(2005,"APDTPX",DFN,RDT,X,DA)
  1.  Q
  1.  ;
  1. SETPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
  1.  ;XREF FOR FIELD#15
  1.  ;^MAG(2005,"APPXDT",DFN,PX,reverseDT)=""
  1.  N DFN,PX,RDT,ER
  1.  D SETUP5 Q:$D(ER)
  1.  S ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)=""
  1.  S ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)=""
  1.  Q
  1.  ;
  1. SETUP5 ; Set up for date/time procedure field #15
  1.  S DFN=$P(^MAG(2005,DA,0),U,7),PX=$P(^(0),U,8)
  1.  I PX="" S ER=1 Q
  1.  I DFN="" S ER=1 Q
  1.  S RDT=9999999.9999-X
  1.  Q
  1.  ;
  1. KILPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
  1.  N DFN,CDT,ER
  1.  D SETUP5 Q:$D(ER)
  1.  K ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)
  1.  K ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)
  1.  Q
  1.  ;
  1. SETDCM ; Set the cross reference for DICOM SERIES NUM
  1.  ; and DICOM IMAGE NUM fields of the OBJECT GROUP Multiple
  1.  N MAGDSN,MAGDIN
  1.  I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
  1.  S Z=+^MAG(2005,DA(1),1,DA,0)
  1.  S ^MAG(2005,DA(1),1,"ADCM",MAGDSN,MAGDIN,Z,DA)=""
  1.  Q
  1.  ;
  1. KILLDSN ; Kill the cross reference for DICOM SERIES NUM
  1.  N MAGDSN,MAGDIN
  1.  I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
  1.  S Z=+^MAG(2005,DA(1),1,DA,0)
  1.  K ^MAG(2005,DA(1),1,"ADCM",X,MAGDIN,Z,DA)
  1.  Q
  1.  ;
  1. KILLDIN ; Kill the DICOM IMAGE NUM cross reference
  1.  ; of the OBJECT GROUP Multiple
  1.  N MAGDSN,MAGDIN
  1.  I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
  1.  S Z=+^MAG(2005,DA(1),1,DA,0)
  1.  K ^MAG(2005,DA(1),1,"ADCM",MAGDSN,X,Z,DA)
  1.  Q
  1.  ;
  1. BOTHNUM(MAGDSN,MAGDIN) ;
  1.  S MAGDSN=$P($G(^MAG(2005,DA(1),1,DA,0)),U,2)
  1.  S MAGDIN=$P($G(^MAG(2005,DA(1),1,DA,0)),U,3)
  1.  ;GEK 4/4/00
  1.  ; Changed to test for "", not to test I 'DINUM (0 would fail)
  1.  I ((MAGDIN="")!(MAGDSN="")) Q 0
  1.  Q 1
  1.  ;
  1.  ;***** SAVES OLD FIELD VALUES TO THE AUDIT MULTIPLE
  1.  ;
  1.  ; FILE          Number of the file that audited fields belong to.
  1.  ;
  1.  ; IENS          Standard IENS of the record that has been updated.
  1.  ;
  1.  ; FLDLST        Numbers of audited fields separated by semicolons.
  1.  ;               Positions of field numbers should match subscripts
  1.  ;               (order numbers) in the X1 and X2 arrays.
  1.  ;
  1.  ; SUBFILE       Subfile number of the audit multiple of the file
  1.  ;               defined by the FILE parameter (e.g. 99 for the
  1.  ;               IMAGE file (#2005)).
  1.  ;
  1.  ; .X1           Reference to a local array that stores old values
  1.  ;               of audited fields. Subscripts of this array are
  1.  ;               order numbers of fields included in the audit
  1.  ;               index/action definition.
  1.  ;
  1.  ; .X2           Reference to a local array that stores new values
  1.  ;               of audited fields. Subscripts of this array are
  1.  ;               order numbers of fields included in the audit
  1.  ;               index/action definition.
  1.  ;
  1.  ; Input Variables
  1.  ; ===============
  1.  ;
  1.  ; MAGNOFMAUDIT  If this variable is defined and not 0, then audit
  1.  ;               is not performed. You can use this variable to
  1.  ;               disable audit during creation of a record when a
  1.  ;               basic record is created first and then its fields
  1.  ;               are populated by separate VA FileMan call(s).
  1.  ;
  1.  ; Notes
  1.  ; =====
  1.  ;
  1.  ; Definition of an index/action that performs the audit must always
  1.  ; include the .01 field as the first item (order number = 1).
  1.  ;
  1.  ; If you do not want to track changes of the .01 field, leave the
  1.  ; first piece of the FLDLST parameter empty.
  1.  ;
  1.  ; See the AUDIT40 index of the IMAGE file (#2005) for an example.
  1.  ;
  1. AUDIT(FILE,IENS,FLDLST,SUBFILE,X1,X2) ;
  1.  ;--- Do not do anything if audit is disabled by an application
  1.  ;--- (e.g. during creation and initial population of a record).
  1.  Q:$G(MAGNOFMAUDIT)
  1.  ;--- Do not do anything if the record is created or
  1.  ;--- deleted (.01 field is empty or not defined)
  1.  Q:($G(X1(1))="")!($G(X2(1))="")
  1.  ;--- Initialize variables
  1.  N AIENS,EXTVAL,FLD,I,INTVAL,MAGFDA,MAGMSG,NF,NOW
  1.  S NOW=$$NOW^XLFDT
  1.  ;===
  1.  S NF=$L(FLDLST,";")
  1.  F I=1:1:NF  S FLD=+$P(FLDLST,";",I)  D:FLD>0
  1.  . S INTVAL=$G(X1(I))  Q:$G(X2(I))=INTVAL
  1.  . ;--- Prepare data for the audit multiple
  1.  . S AIENS="+"_I_","_IENS
  1.  . S MAGFDA(SUBFILE,AIENS,.01)=NOW      ; DATE/TIME RECORDED
  1.  . S MAGFDA(SUBFILE,AIENS,.02)=FLD      ; FIELD NUMBER
  1.  . S MAGFDA(SUBFILE,AIENS,.03)=$G(DUZ)  ; USER
  1.  . ;--- Do not create global nodes for empty values
  1.  . Q:INTVAL=""
  1.  . S MAGFDA(SUBFILE,AIENS,1)=INTVAL     ; OLD INTERNAL VALUE
  1.  . ;--- The external value is stored only if it is
  1.  . ;--- different from the internal one
  1.  . S EXTVAL=$$EXTERNAL^DILFD(FILE,FLD,,INTVAL,"MAGMSG")
  1.  . S:$G(DIERR) EXTVAL="<ERROR>"
  1.  . S:EXTVAL'=INTVAL MAGFDA(SUBFILE,AIENS,2)=EXTVAL
  1.  . Q
  1.  ;===
  1.  D:$D(MAGFDA)>1 UPDATE^DIE(,"MAGFDA",,"MAGMSG")
  1.  Q