source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGUXRF.m@ 789

Last change on this file since 789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1MAGUXRF ;WOIFO/SRR - Imaging MUMPS cross-references ; 03/08/2005 09:16
2 ;;3.0;IMAGING;**51**;26-August-2005
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 ;; | |
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 ;;
18SETACT D AC(1) Q
19KILLACT D AC(0) Q
20 ;
21AC(SETKIL) N ACTION,ROUTINE,TYPE
22 ; "AC" Cross Reference for OBJECT TYPE - ACTION subfile
23 ; ^MAG(2005.02,"AC",OBJECT TYPE,ACTION)=OBJECT TYPE^ACTION ROUTINE
24 S TYPE=$P(^MAG(2005.02,DA(1),0),"^",1)
25 S ACTION=^MAG(2005.02,DA(1),1,DA,0)
26 S ROUTINE=$P(ACTION,".",2),ACTION=$P(ACTION,".",1)
27 S:SETKIL ^MAG(2005.02,"AC",TYPE,ACTION)=TYPE_"^"_ROUTINE
28 K:'SETKIL ^MAG(2005.02,"AC",TYPE,ACTION)
29 K MAGACT1,MAGMETH,MAG
30 Q
31 ;
32SETPX ; Set PACS switch on; check fields first
33 ; Write checks
34 S ^MAG(2006.1,"APACS")=1
35 Q
36 ;
37KILPX ; Stop PACS system
38 K ^MAG(2006.1,"APACS")
39 Q
40 ;
41SETPDPX ; Set P(atient) D(ate) PX(procedure)
42 D SET Q:PDT="" Q:DFN=""
43 S ^MAG(2005,"APDPX",DFN,PDT,PX,DA)=""
44 Q
45 ;
46SET S X0=^MAG(2005,DA,0),X2=$G(^(2))
47 S PDT=$P(X2,U,5) I PDT="" S PDT=$P(X2,U) Q:PDT=""
48 S DFN=$P(X0,U,7) Q:DFN=""
49 ;
504 S PX=$P(X0,U,8) I PX="" S PX="OTHER"
51 Q
52 ;
53KILPDPX ; Kill
54 D SET Q:PDT="" Q:DFN=""
55 K ^MAG(2005,"APDPX",DFN,PDT,PX,DA)
56 Q
57 ;
58SETPPXD ; #5:Set (patient=X=DFN); #6:PX(procedure); #15:DT(procedure date/time)
59 ; Xref for patient field#5=Patient name (in form of DFN)
60 ; ^MAG(2005,"APPXDT",X,PX,reverseDT)=""
61 N CDT,RDT,PX,ER
62 D SETUP Q:$D(ER)
63 S ^MAG(2005,"APPXDT",X,PX,RDT,DA)=""
64 S ^MAG(2005,"APDTPX",X,RDT,PX,DA)=""
65 Q
66 ;
67SETUP ; Set up for patient Xref's-for field #5l
68 S PX=$P(^MAG(2005,DA,0),U,8),CDT=$P($G(^(2)),U,5)
69 I CDT="" S ER=1 Q
70 I PX="" S ER=1 Q
71 S RDT=9999999.9999-CDT
72 Q
73 ;
74KILPPXD ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
75 N CDT,PX,RDT,ER
76 D SETUP Q:$D(ER)
77 K ^MAG(2005,"APPXDT",X,PX,RDT,DA)
78 K ^MAG(2005,"APDTPX",X,RDT,PX,DA)
79 Q
80 ;
81SETPPXD6 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
82 ;XREF FOR PROCEDURE,FIELD#6
83 N DFN,CDT,RDT,ER
84 D SETUP6 Q:$D(ER)
85 S ^MAG(2005,"APPXDT",DFN,X,RDT,DA)=""
86 S ^MAG(2005,"APDTPX",DFN,RDT,X,DA)=""
87 Q
88 ;
89SETUP6 ; Set up for procedure xref-field#6
90 S DFN=$P(^MAG(2005,DA,0),U,7),CDT=$P($G(^(2)),U,5)
91 I CDT="" S ER=1 Q
92 I DFN="" S ER=1 Q
93 S RDT=9999999.9999-CDT
94 Q
95 ;
96KILPPXD6 ;#5:KILL (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
97 N DFN,CDT,RDT,ER
98 D SETUP6 Q:$D(ER)
99 K ^MAG(2005,"APPXDT",DFN,X,RDT,DA)
100 K ^MAG(2005,"APDTPX",DFN,RDT,X,DA)
101 Q
102 ;
103SETPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
104 ;XREF FOR FIELD#15
105 ;^MAG(2005,"APPXDT",DFN,PX,reverseDT)=""
106 N DFN,PX,RDT,ER
107 D SETUP5 Q:$D(ER)
108 S ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)=""
109 S ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)=""
110 Q
111 ;
112SETUP5 ; Set up for for date/time procedure field#15
113 S DFN=$P(^MAG(2005,DA,0),U,7),PX=$P(^(0),U,8)
114 I PX="" S ER=1 Q
115 I DFN="" S ER=1 Q
116 S RDT=9999999.9999-X
117 Q
118 ;
119KILPPXD5 ;#5:SET (PATIENT=X=DFN); #6:PX(PROCEDURE); #15:DT(PROCEDURE DATE/TIME)
120 N DFN,CDT,ER
121 D SETUP5 Q:$D(ER)
122 K ^MAG(2005,"APPXDT",DFN,PX,RDT,DA)
123 K ^MAG(2005,"APDTPX",DFN,RDT,PX,DA)
124 Q
125 ;
126SETDCM ; Set the cross reference for DICOM SERIES NUM
127 ; and DICOM IMAGE NUM fields of the OBJECT GROUP Multiple
128 N MAGDSN,MAGDIN
129 I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
130 S Z=+^MAG(2005,DA(1),1,DA,0)
131 S ^MAG(2005,DA(1),1,"ADCM",MAGDSN,MAGDIN,Z,DA)=""
132 Q
133 ;
134KILLDSN ; Kill the cross reference for DICOM SERIES NUM
135 N MAGDSN,MAGDIN
136 I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
137 S Z=+^MAG(2005,DA(1),1,DA,0)
138 K ^MAG(2005,DA(1),1,"ADCM",X,MAGDIN,Z,DA)
139 Q
140 ;
141KILLDIN ; Kill the DICOM IMAGE NUM cross reference
142 ; of the OBJECT GROUP Multiple
143 N MAGDSN,MAGDIN
144 I '$$BOTHNUM(.MAGDSN,.MAGDIN) Q
145 S Z=+^MAG(2005,DA(1),1,DA,0)
146 K ^MAG(2005,DA(1),1,"ADCM",MAGDSN,X,Z,DA)
147 Q
148 ;
149BOTHNUM(MAGDSN,MAGDIN) ;
150 S MAGDSN=$P($G(^MAG(2005,DA(1),1,DA,0)),U,2)
151 S MAGDIN=$P($G(^MAG(2005,DA(1),1,DA,0)),U,3)
152 ;GEK 4/4/00
153 ; Changed to test for "", not to test I 'DINUM (0 would fail)
154 I ((MAGDIN="")!(MAGDSN="")) Q 0
155 Q 1
Note: See TracBrowser for help on using the repository browser.