MAGUXRF ;WOIFO/SRR/SG/NST - Imaging MUMPS cross-references ; 29 Oct 2010 2:23 PM
;;3.0;IMAGING;**51,93,106**;Mar 19, 2002;Build 2002;Feb 28, 2011
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
SETACT D AC(1) Q
KILLACT D AC(0) Q
;
AC(SETKIL) N ACTION,ROUTINE,TYPE
; "AC" Cross Reference for OBJECT TYPE - ACTION subfile
; ^MAG(2005.02,"AC",OBJECT TYPE,ACTION)=OBJECT TYPE^ACTION ROUTINE
S TYPE=$P(^MAG(2005.02,DA(1),0),"^",1)
S ACTION=^MAG(2005.02,DA(1),1,DA,0)
S ROUTINE=$P(ACTION,".",2),ACTION=$P(ACTION,".",1)
S:SETKIL ^MAG(2005.02,"AC",TYPE,ACTION)=TYPE_"^"_ROUTINE
K:'SETKIL ^MAG(2005.02,"AC",TYPE,ACTION)
K MAGACT1,MAGMETH,MAG
Q
;
SETPX ; Set PACS switch on; check fields first
; Write checks
S ^MAG(2006.1,"APACS")=1
Q
;
KILPX ; Stop PACS system
K ^MAG(2006.1,"APACS")
Q
;
SETPDPX ; Set P(atient) D(ate) PX(procedure)
D SET Q:PDT="" Q:DFN=""
S ^MAG(2005,"APDPX",DFN,PDT,PX,DA)=""
Q
;
SET S X0=^MAG(2005,DA,0),X2=$G(^(2))
S PDT=$P(X2,U,5) I PDT="" S PDT=$P(X2,U) Q:PDT=""
S DFN=$P(X0,U,7) Q:DFN=""
;
4 S PX=$P(X0,U,8) I PX="" S PX="OTHER"
Q
;
KILPDPX ; Kill
D SET Q:PDT="" Q:DFN=""
K ^MAG(2005,"APDPX",DFN,PDT,PX,DA)
Q
;
SETPPXD ; #5:Set (patient=X=DFN); #6:PX(procedure); #15:DT(procedure date/time)
; Xref for patient field#5=Patient name (in form of DFN)
; ^MAG(2005,"APPXDT",X,PX,reverseDT)=""
N CDT,RDT,PX,ER
D SETUP Q:$D(ER)
S ^MAG(2005,"APPXDT",X,PX,RDT,DA)=""
S ^MAG(2005,"APDTPX",X,RDT,PX,DA)=""
Q
;
SETUP ; Set up for patient Xref's-for field #5l
S PX=$P(^MAG(2005,DA,0),U,8),CDT=$P($G(^(2)),U,5)
I CDT="" S ER=1 Q
I PX="" S ER=1 Q
S RDT=9999999.9999-CDT
Q
;
KILPPXD ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
N CDT,PX,RDT,ER
D SETUP Q:$D(ER)
K ^MAG(2005,"APPXDT",X,PX,RDT,DA)
K ^MAG(2005,"APDTPX",X,RDT,PX,DA)
Q
;
SETPPXD6 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
;XREF FOR PROCEDURE,FIELD#6
N DFN,CDT,RDT,ER
D SETUP6 Q:$D(ER)
S ^MAG(2005,"APPXDT",DFN,X,RDT,DA)=""
S ^MAG(2005,"APDTPX",DFN,RDT,X,DA)=""
Q
;
SETUP6 ; Set up for procedure xref-field#6
S DFN=$P(^MAG(2005,DA,0),U,7),CDT=$P($G(^(2)),U,5)
I CDT="" S ER=1 Q
I DFN="" S ER=1 Q
S RDT=9999999.9999-CDT
Q
;
KILPPXD6 ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
N DFN,CDT,RDT,ER
D SETUP6 Q:$D(ER)
K ^MAG(2005,"APPXDT",DFN,X,RDT,DA)
K ^MAG(2005,"APDTPX",DFN,RDT,X,DA)
Q
;
SETPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
;XREF FOR FIELD#15
;^MAG(2005,"APPXDT",DFN,PX,reverseDT)=""
N DFN,PX,RDT,ER
D SETUP5 Q:$D(ER)
S ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)=""
S ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)=""
Q
;
SETUP5 ; Set up for date/time procedure field #15
S DFN=$P(^MAG(2005,DA,0),U,7),PX=$P(^(0),U,8)
I PX="" S ER=1 Q
I DFN="" S ER=1 Q
S RDT=9999999.9999-X
Q
;
KILPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
N DFN,CDT,ER
D SETUP5 Q:$D(ER)
K ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)
K ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)
Q
;
SETDCM ; Set the cross reference for DICOM SERIES NUM
; and DICOM IMAGE NUM fields of the OBJECT GROUP Multiple
N MAGDSN,MAGDIN
I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
S Z=+^MAG(2005,DA(1),1,DA,0)
S ^MAG(2005,DA(1),1,"ADCM",MAGDSN,MAGDIN,Z,DA)=""
Q
;
KILLDSN ; Kill the cross reference for DICOM SERIES NUM
N MAGDSN,MAGDIN
I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
S Z=+^MAG(2005,DA(1),1,DA,0)
K ^MAG(2005,DA(1),1,"ADCM",X,MAGDIN,Z,DA)
Q
;
KILLDIN ; Kill the DICOM IMAGE NUM cross reference
; of the OBJECT GROUP Multiple
N MAGDSN,MAGDIN
I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
S Z=+^MAG(2005,DA(1),1,DA,0)
K ^MAG(2005,DA(1),1,"ADCM",MAGDSN,X,Z,DA)
Q
;
BOTHNUM(MAGDSN,MAGDIN) ;
S MAGDSN=$P($G(^MAG(2005,DA(1),1,DA,0)),U,2)
S MAGDIN=$P($G(^MAG(2005,DA(1),1,DA,0)),U,3)
;GEK 4/4/00
; Changed to test for "", not to test I 'DINUM (0 would fail)
I ((MAGDIN="")!(MAGDSN="")) Q 0
Q 1
;
;***** SAVES OLD FIELD VALUES TO THE AUDIT MULTIPLE
;
; FILE Number of the file that audited fields belong to.
;
; IENS Standard IENS of the record that has been updated.
;
; FLDLST Numbers of audited fields separated by semicolons.
; Positions of field numbers should match subscripts
; (order numbers) in the X1 and X2 arrays.
;
; SUBFILE Subfile number of the audit multiple of the file
; defined by the FILE parameter (e.g. 99 for the
; IMAGE file (#2005)).
;
; .X1 Reference to a local array that stores old values
; of audited fields. Subscripts of this array are
; order numbers of fields included in the audit
; index/action definition.
;
; .X2 Reference to a local array that stores new values
; of audited fields. Subscripts of this array are
; order numbers of fields included in the audit
; index/action definition.
;
; Input Variables
; ===============
;
; MAGNOFMAUDIT If this variable is defined and not 0, then audit
; is not performed. You can use this variable to
; disable audit during creation of a record when a
; basic record is created first and then its fields
; are populated by separate VA FileMan call(s).
;
; Notes
; =====
;
; Definition of an index/action that performs the audit must always
; include the .01 field as the first item (order number = 1).
;
; If you do not want to track changes of the .01 field, leave the
; first piece of the FLDLST parameter empty.
;
; See the AUDIT40 index of the IMAGE file (#2005) for an example.
;
AUDIT(FILE,IENS,FLDLST,SUBFILE,X1,X2) ;
;--- Do not do anything if audit is disabled by an application
;--- (e.g. during creation and initial population of a record).
Q:$G(MAGNOFMAUDIT)
;--- Do not do anything if the record is created or
;--- deleted (.01 field is empty or not defined)
Q:($G(X1(1))="")!($G(X2(1))="")
;--- Initialize variables
N AIENS,EXTVAL,FLD,I,INTVAL,MAGFDA,MAGMSG,NF,NOW
S NOW=$$NOW^XLFDT
;===
S NF=$L(FLDLST,";")
F I=1:1:NF S FLD=+$P(FLDLST,";",I) D:FLD>0
. S INTVAL=$G(X1(I)) Q:$G(X2(I))=INTVAL
. ;--- Prepare data for the audit multiple
. S AIENS="+"_I_","_IENS
. S MAGFDA(SUBFILE,AIENS,.01)=NOW ; DATE/TIME RECORDED
. S MAGFDA(SUBFILE,AIENS,.02)=FLD ; FIELD NUMBER
. S MAGFDA(SUBFILE,AIENS,.03)=$G(DUZ) ; USER
. ;--- Do not create global nodes for empty values
. Q:INTVAL=""
. S MAGFDA(SUBFILE,AIENS,1)=INTVAL ; OLD INTERNAL VALUE
. ;--- The external value is stored only if it is
. ;--- different from the internal one
. S EXTVAL=$$EXTERNAL^DILFD(FILE,FLD,,INTVAL,"MAGMSG")
. S:$G(DIERR) EXTVAL="<ERROR>"
. S:EXTVAL'=INTVAL MAGFDA(SUBFILE,AIENS,2)=EXTVAL
. Q
;===
D:$D(MAGFDA)>1 UPDATE^DIE(,"MAGFDA",,"MAGMSG")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUXRF 8017 printed Dec 13, 2024@02:09:13 Page 2
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
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
SETACT DO AC(1)
QUIT
KILLACT DO AC(0)
QUIT
+1 ;
AC(SETKIL) NEW ACTION,ROUTINE,TYPE
+1 ; "AC" Cross Reference for OBJECT TYPE - ACTION subfile
+2 ; ^MAG(2005.02,"AC",OBJECT TYPE,ACTION)=OBJECT TYPE^ACTION ROUTINE
+3 SET TYPE=$PIECE(^MAG(2005.02,DA(1),0),"^",1)
+4 SET ACTION=^MAG(2005.02,DA(1),1,DA,0)
+5 SET ROUTINE=$PIECE(ACTION,".",2)
SET ACTION=$PIECE(ACTION,".",1)
+6 if SETKIL
SET ^MAG(2005.02,"AC",TYPE,ACTION)=TYPE_"^"_ROUTINE
+7 if 'SETKIL
KILL ^MAG(2005.02,"AC",TYPE,ACTION)
+8 KILL MAGACT1,MAGMETH,MAG
+9 QUIT
+10 ;
SETPX ; Set PACS switch on; check fields first
+1 ; Write checks
+2 SET ^MAG(2006.1,"APACS")=1
+3 QUIT
+4 ;
KILPX ; Stop PACS system
+1 KILL ^MAG(2006.1,"APACS")
+2 QUIT
+3 ;
SETPDPX ; Set P(atient) D(ate) PX(procedure)
+1 DO SET
if PDT=""
QUIT
if DFN=""
QUIT
+2 SET ^MAG(2005,"APDPX",DFN,PDT,PX,DA)=""
+3 QUIT
+4 ;
SET SET X0=^MAG(2005,DA,0)
SET X2=$GET(^(2))
+1 SET PDT=$PIECE(X2,U,5)
IF PDT=""
SET PDT=$PIECE(X2,U)
if PDT=""
QUIT
+2 SET DFN=$PIECE(X0,U,7)
if DFN=""
QUIT
+3 ;
4 SET PX=$PIECE(X0,U,8)
IF PX=""
SET PX="OTHER"
+1 QUIT
+2 ;
KILPDPX ; Kill
+1 DO SET
if PDT=""
QUIT
if DFN=""
QUIT
+2 KILL ^MAG(2005,"APDPX",DFN,PDT,PX,DA)
+3 QUIT
+4 ;
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)
+2 ; ^MAG(2005,"APPXDT",X,PX,reverseDT)=""
+3 NEW CDT,RDT,PX,ER
+4 DO SETUP
if $DATA(ER)
QUIT
+5 SET ^MAG(2005,"APPXDT",X,PX,RDT,DA)=""
+6 SET ^MAG(2005,"APDTPX",X,RDT,PX,DA)=""
+7 QUIT
+8 ;
SETUP ; Set up for patient Xref's-for field #5l
+1 SET PX=$PIECE(^MAG(2005,DA,0),U,8)
SET CDT=$PIECE($GET(^(2)),U,5)
+2 IF CDT=""
SET ER=1
QUIT
+3 IF PX=""
SET ER=1
QUIT
+4 SET RDT=9999999.9999-CDT
+5 QUIT
+6 ;
KILPPXD ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
+1 NEW CDT,PX,RDT,ER
+2 DO SETUP
if $DATA(ER)
QUIT
+3 KILL ^MAG(2005,"APPXDT",X,PX,RDT,DA)
+4 KILL ^MAG(2005,"APDTPX",X,RDT,PX,DA)
+5 QUIT
+6 ;
SETPPXD6 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
+1 ;XREF FOR PROCEDURE,FIELD#6
+2 NEW DFN,CDT,RDT,ER
+3 DO SETUP6
if $DATA(ER)
QUIT
+4 SET ^MAG(2005,"APPXDT",DFN,X,RDT,DA)=""
+5 SET ^MAG(2005,"APDTPX",DFN,RDT,X,DA)=""
+6 QUIT
+7 ;
SETUP6 ; Set up for procedure xref-field#6
+1 SET DFN=$PIECE(^MAG(2005,DA,0),U,7)
SET CDT=$PIECE($GET(^(2)),U,5)
+2 IF CDT=""
SET ER=1
QUIT
+3 IF DFN=""
SET ER=1
QUIT
+4 SET RDT=9999999.9999-CDT
+5 QUIT
+6 ;
KILPPXD6 ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
+1 NEW DFN,CDT,RDT,ER
+2 DO SETUP6
if $DATA(ER)
QUIT
+3 KILL ^MAG(2005,"APPXDT",DFN,X,RDT,DA)
+4 KILL ^MAG(2005,"APDTPX",DFN,RDT,X,DA)
+5 QUIT
+6 ;
SETPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
+1 ;XREF FOR FIELD#15
+2 ;^MAG(2005,"APPXDT",DFN,PX,reverseDT)=""
+3 NEW DFN,PX,RDT,ER
+4 DO SETUP5
if $DATA(ER)
QUIT
+5 SET ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)=""
+6 SET ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)=""
+7 QUIT
+8 ;
SETUP5 ; Set up for date/time procedure field #15
+1 SET DFN=$PIECE(^MAG(2005,DA,0),U,7)
SET PX=$PIECE(^(0),U,8)
+2 IF PX=""
SET ER=1
QUIT
+3 IF DFN=""
SET ER=1
QUIT
+4 SET RDT=9999999.9999-X
+5 QUIT
+6 ;
KILPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
+1 NEW DFN,CDT,ER
+2 DO SETUP5
if $DATA(ER)
QUIT
+3 KILL ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)
+4 KILL ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)
+5 QUIT
+6 ;
SETDCM ; Set the cross reference for DICOM SERIES NUM
+1 ; and DICOM IMAGE NUM fields of the OBJECT GROUP Multiple
+2 NEW MAGDSN,MAGDIN
+3 IF '$$BOTHNUM(.MAGDSN,.MAGDIN)
QUIT
+4 SET Z=+^MAG(2005,DA(1),1,DA,0)
+5 SET ^MAG(2005,DA(1),1,"ADCM",MAGDSN,MAGDIN,Z,DA)=""
+6 QUIT
+7 ;
KILLDSN ; Kill the cross reference for DICOM SERIES NUM
+1 NEW MAGDSN,MAGDIN
+2 IF '$$BOTHNUM(.MAGDSN,.MAGDIN)
QUIT
+3 SET Z=+^MAG(2005,DA(1),1,DA,0)
+4 KILL ^MAG(2005,DA(1),1,"ADCM",X,MAGDIN,Z,DA)
+5 QUIT
+6 ;
KILLDIN ; Kill the DICOM IMAGE NUM cross reference
+1 ; of the OBJECT GROUP Multiple
+2 NEW MAGDSN,MAGDIN
+3 IF '$$BOTHNUM(.MAGDSN,.MAGDIN)
QUIT
+4 SET Z=+^MAG(2005,DA(1),1,DA,0)
+5 KILL ^MAG(2005,DA(1),1,"ADCM",MAGDSN,X,Z,DA)
+6 QUIT
+7 ;
BOTHNUM(MAGDSN,MAGDIN) ;
+1 SET MAGDSN=$PIECE($GET(^MAG(2005,DA(1),1,DA,0)),U,2)
+2 SET MAGDIN=$PIECE($GET(^MAG(2005,DA(1),1,DA,0)),U,3)
+3 ;GEK 4/4/00
+4 ; Changed to test for "", not to test I 'DINUM (0 would fail)
+5 IF ((MAGDIN="")!(MAGDSN=""))
QUIT 0
+6 QUIT 1
+7 ;
+8 ;***** SAVES OLD FIELD VALUES TO THE AUDIT MULTIPLE
+9 ;
+10 ; FILE Number of the file that audited fields belong to.
+11 ;
+12 ; IENS Standard IENS of the record that has been updated.
+13 ;
+14 ; FLDLST Numbers of audited fields separated by semicolons.
+15 ; Positions of field numbers should match subscripts
+16 ; (order numbers) in the X1 and X2 arrays.
+17 ;
+18 ; SUBFILE Subfile number of the audit multiple of the file
+19 ; defined by the FILE parameter (e.g. 99 for the
+20 ; IMAGE file (#2005)).
+21 ;
+22 ; .X1 Reference to a local array that stores old values
+23 ; of audited fields. Subscripts of this array are
+24 ; order numbers of fields included in the audit
+25 ; index/action definition.
+26 ;
+27 ; .X2 Reference to a local array that stores new values
+28 ; of audited fields. Subscripts of this array are
+29 ; order numbers of fields included in the audit
+30 ; index/action definition.
+31 ;
+32 ; Input Variables
+33 ; ===============
+34 ;
+35 ; MAGNOFMAUDIT If this variable is defined and not 0, then audit
+36 ; is not performed. You can use this variable to
+37 ; disable audit during creation of a record when a
+38 ; basic record is created first and then its fields
+39 ; are populated by separate VA FileMan call(s).
+40 ;
+41 ; Notes
+42 ; =====
+43 ;
+44 ; Definition of an index/action that performs the audit must always
+45 ; include the .01 field as the first item (order number = 1).
+46 ;
+47 ; If you do not want to track changes of the .01 field, leave the
+48 ; first piece of the FLDLST parameter empty.
+49 ;
+50 ; See the AUDIT40 index of the IMAGE file (#2005) for an example.
+51 ;
AUDIT(FILE,IENS,FLDLST,SUBFILE,X1,X2) ;
+1 ;--- Do not do anything if audit is disabled by an application
+2 ;--- (e.g. during creation and initial population of a record).
+3 if $GET(MAGNOFMAUDIT)
QUIT
+4 ;--- Do not do anything if the record is created or
+5 ;--- deleted (.01 field is empty or not defined)
+6 if ($GET(X1(1))="")!($GET(X2(1))="")
QUIT
+7 ;--- Initialize variables
+8 NEW AIENS,EXTVAL,FLD,I,INTVAL,MAGFDA,MAGMSG,NF,NOW
+9 SET NOW=$$NOW^XLFDT
+10 ;===
+11 SET NF=$LENGTH(FLDLST,";")
+12 FOR I=1:1:NF
SET FLD=+$PIECE(FLDLST,";",I)
if FLD>0
Begin DoDot:1
+13 SET INTVAL=$GET(X1(I))
if $GET(X2(I))=INTVAL
QUIT
+14 ;--- Prepare data for the audit multiple
+15 SET AIENS="+"_I_","_IENS
+16 ; DATE/TIME RECORDED
SET MAGFDA(SUBFILE,AIENS,.01)=NOW
+17 ; FIELD NUMBER
SET MAGFDA(SUBFILE,AIENS,.02)=FLD
+18 ; USER
SET MAGFDA(SUBFILE,AIENS,.03)=$GET(DUZ)
+19 ;--- Do not create global nodes for empty values
+20 if INTVAL=""
QUIT
+21 ; OLD INTERNAL VALUE
SET MAGFDA(SUBFILE,AIENS,1)=INTVAL
+22 ;--- The external value is stored only if it is
+23 ;--- different from the internal one
+24 SET EXTVAL=$$EXTERNAL^DILFD(FILE,FLD,,INTVAL,"MAGMSG")
+25 if $GET(DIERR)
SET EXTVAL="<ERROR>"
+26 if EXTVAL'=INTVAL
SET MAGFDA(SUBFILE,AIENS,2)=EXTVAL
+27 QUIT
End DoDot:1
+28 ;===
+29 if $DATA(MAGFDA)>1
DO UPDATE^DIE(,"MAGFDA",,"MAGMSG")
+30 QUIT
