source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDTR06.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 
1MAGDTR06 ;WOIFO/PMK - Read a DICOM image file ; 15 Nov 2006 7:03 AM
2 ;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
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 ;;
18GETSITES(OUT) ; MAG DICOM CON UNREAD ACQ SITES
19 N ACQSITE,ADMNSITE,I,J,LOCKTIME,PRIMARY,X
20 S J=0
21 S I=0 F S I=$O(^MAG(2006.5842,I)) Q:'I S X=^(I,0) D GETSITE1
22 S OUT(1)=J
23 Q
24 ;
25GETSITE1 ;
26 S J=J+1
27 S ACQSITE=$P(X,"^",1),PRIMARY=$P(X,"^",2)
28 S ADMNSITE=$P(X,"^",3),LOCKTIME=$P(X,"^",4)
29 S OUT(J+1)=$$GET1^DIQ(4,ACQSITE,99)_"|"_$$GET1^DIQ(4,ACQSITE,.01)_"|"_PRIMARY_"|"_ADMNSITE_"|"_LOCKTIME
30 Q
31 ;
32GETREAD(OUT) ; MAG DICOM CON GET TELE READER
33 N ACQSITE,I,IPROCIDX,ISPECIDX,LOCKTIME,PRIMARY,XACQSITE,X,XDUZ,XPROCIDX,XSPECIDX
34 N ADMNPROC,ADMNSITE,ADMNSPEC,USERPREF
35 ;
36 S (I,XDUZ)=0
37 F S XDUZ=$O(^MAG(2006.5843,"B",DUZ,XDUZ)) Q:'XDUZ S XACQSITE=0 D
38 . F S XACQSITE=$O(^MAG(2006.5843,XDUZ,1,XACQSITE)) Q:'XACQSITE D
39 . . S X=^MAG(2006.5843,XDUZ,1,XACQSITE,0)
40 . . S ACQSITE=$P(X,"^",1),ADMNSITE=$P(X,"^",2)
41 . . S PRIMARY=$P(^MAG(2006.5842,ACQSITE,0),"^",2),LOCKTIME=$P(^(0),"^",4)
42 . . ; an inactive site in file 2006.5842 overrides the active for the user
43 . . I ADMNSITE S ADMNSITE=$P(^MAG(2006.5842,ACQSITE,0),"^",3) ; site is not active
44 . . S XSPECIDX=0
45 . . F S XSPECIDX=$O(^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX)) Q:'XSPECIDX D
46 . . . S X=^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,0)
47 . . . S ISPECIDX=$P(X,"^",1),ADMNSPEC=$P(X,"^",2)
48 . . . S XPROCIDX=0
49 . . . F S XPROCIDX=$O(^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,1,XPROCIDX)) Q:'XPROCIDX D
50 . . . . S X=^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,1,XPROCIDX,0)
51 . . . . S IPROCIDX=$P(X,"^",1),ADMNPROC=$P(X,"^",2),USERPREF=$P(X,"^",3)
52 . . . . S X=$$GET1^DIQ(4,ACQSITE,99)_"|"_$$GET1^DIQ(4,ACQSITE,.01)
53 . . . . S X=X_"|"_PRIMARY_"|"_ADMNSITE_"|"_LOCKTIME
54 . . . . S X=X_"|"_ISPECIDX_"|"_$$GET1^DIQ(2005.84,ISPECIDX,.01)_"|"_ADMNSPEC
55 . . . . S X=X_"|"_IPROCIDX_"|"_$$GET1^DIQ(2005.85,IPROCIDX,.01)_"|"_ADMNPROC
56 . . . . S X=X_"|"_USERPREF
57 . . . . S I=I+1,OUT(I+1)=X
58 . . . . Q
59 . . . Q
60 . . Q
61 . Q
62 S OUT(1)=I
63 Q
64 ;
65SETREAD(OUT,SITENUMB,ISPECIDX,IPROCIDX,USERPREF) ; MAG DICOM CON SET TELE READER
66 N ACQSITE,IENDUZ,IENSITE,IENSPEC,IENPROC,X
67 I '$G(SITENUMB) S OUT="-1, ACQUISITION SITE PARAMETER IS NOT DEFINED"
68 E I '$G(ISPECIDX) S OUT="-2, SPECIALTY PARAMETER IS NOT DEFINED"
69 E I '$G(IPROCIDX) S OUT="-3, PROCEDURE PARAMETER IS NOT DEFINED"
70 E I '$D(USERPREF) S OUT="-4, USER PREFERENCE SELCTION IS NOT DEFINED"
71 E I USERPREF'=0,USERPREF'=1 S OUT="-5, ILLEGAL VALUE FOR USER PREFERENCE: <<"_USERPREF_">>"
72 E D
73 . S IENDUZ=$O(^MAG(2006.5843,"B",DUZ,0))
74 . I 'IENDUZ S OUT="-6, USER (DUZ) #"_DUZ_" IS NOT DEFINED IN FILE 2006.5849" Q
75 . ;
76 . S ACQSITE=+$$ACQSITE(SITENUMB)
77 . I ACQSITE<0 S OUT="-7, ACQUISITION SITE #"_SITENUMB_" IS NOT DEFINED IN FILE 4" Q
78 . ;
79 . S IENSITE=$O(^MAG(2006.5843,IENDUZ,1,"B",ACQSITE,0))
80 . I 'IENSITE S OUT="-8, ACQUISITION SITE #"_ACQSITE_" IS NOT DEFINED IN FILE 2006.5849" Q
81 . ;
82 . S IENSPEC=$O(^MAG(2006.5843,IENDUZ,1,IENSITE,1,"B",ISPECIDX,0))
83 . I 'IENSPEC S OUT="-9, SPECIALTY #"_ISPECIDX_" IS NOT DEFINED IN FILE 2006.5849" Q
84 . ;
85 . S IENPROC=$O(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,"B",IPROCIDX,0))
86 . I 'IENPROC S OUT="-10, PROCEDURE #"_IPROCIDX_" IS NOT DEFINED IN FILE 2006.5849" Q
87 . ;
88 . I $D(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,IENPROC,0)) S X=^(0) D
89 . . I $P(X,"^",3)=USERPREF S OUT="2, USER PREFERENCE ALREADY SET"
90 . . E D
91 . . . S $P(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,IENPROC,0),"^",3)=USERPREF
92 . . . S OUT="1, USER PREFERENCE SET"
93 . . . Q
94 . . Q
95 . E S OUT="-10, PROCEDURE #"_IPROCIDX_" IS NOT DEFINED IN FILE 2006.5849"
96 . Q
97 Q
98 ;
99ACQSITE(SITENUMB) ; lookup an institution by the site number
100 N D,DIC,U,X,Y
101 S DIC="^DIC(4," ; INSTITUTION is file #4
102 S D="D" ; use the "D" cross-reference
103 S DIC(0)="X" ; only find the exact matching entry
104 S X=SITENUMB
105 D IX^DIC
106 Q Y
Note: See TracBrowser for help on using the repository browser.