107 lines
4.7 KiB
Mathematica
107 lines
4.7 KiB
Mathematica
MAGDTR06 ;WOIFO/PMK - Read a DICOM image file ; 15 Nov 2006 7:03 AM
|
|
;;3.0;IMAGING;**46**;16-February-2007;;Build 1023
|
|
;; 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. |
|
|
;; +---------------------------------------------------------------+
|
|
;;
|
|
GETSITES(OUT) ; MAG DICOM CON UNREAD ACQ SITES
|
|
N ACQSITE,ADMNSITE,I,J,LOCKTIME,PRIMARY,X
|
|
S J=0
|
|
S I=0 F S I=$O(^MAG(2006.5842,I)) Q:'I S X=^(I,0) D GETSITE1
|
|
S OUT(1)=J
|
|
Q
|
|
;
|
|
GETSITE1 ;
|
|
S J=J+1
|
|
S ACQSITE=$P(X,"^",1),PRIMARY=$P(X,"^",2)
|
|
S ADMNSITE=$P(X,"^",3),LOCKTIME=$P(X,"^",4)
|
|
S OUT(J+1)=$$GET1^DIQ(4,ACQSITE,99)_"|"_$$GET1^DIQ(4,ACQSITE,.01)_"|"_PRIMARY_"|"_ADMNSITE_"|"_LOCKTIME
|
|
Q
|
|
;
|
|
GETREAD(OUT) ; MAG DICOM CON GET TELE READER
|
|
N ACQSITE,I,IPROCIDX,ISPECIDX,LOCKTIME,PRIMARY,XACQSITE,X,XDUZ,XPROCIDX,XSPECIDX
|
|
N ADMNPROC,ADMNSITE,ADMNSPEC,USERPREF
|
|
;
|
|
S (I,XDUZ)=0
|
|
F S XDUZ=$O(^MAG(2006.5843,"B",DUZ,XDUZ)) Q:'XDUZ S XACQSITE=0 D
|
|
. F S XACQSITE=$O(^MAG(2006.5843,XDUZ,1,XACQSITE)) Q:'XACQSITE D
|
|
. . S X=^MAG(2006.5843,XDUZ,1,XACQSITE,0)
|
|
. . S ACQSITE=$P(X,"^",1),ADMNSITE=$P(X,"^",2)
|
|
. . S PRIMARY=$P(^MAG(2006.5842,ACQSITE,0),"^",2),LOCKTIME=$P(^(0),"^",4)
|
|
. . ; an inactive site in file 2006.5842 overrides the active for the user
|
|
. . I ADMNSITE S ADMNSITE=$P(^MAG(2006.5842,ACQSITE,0),"^",3) ; site is not active
|
|
. . S XSPECIDX=0
|
|
. . F S XSPECIDX=$O(^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX)) Q:'XSPECIDX D
|
|
. . . S X=^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,0)
|
|
. . . S ISPECIDX=$P(X,"^",1),ADMNSPEC=$P(X,"^",2)
|
|
. . . S XPROCIDX=0
|
|
. . . F S XPROCIDX=$O(^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,1,XPROCIDX)) Q:'XPROCIDX D
|
|
. . . . S X=^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,1,XPROCIDX,0)
|
|
. . . . S IPROCIDX=$P(X,"^",1),ADMNPROC=$P(X,"^",2),USERPREF=$P(X,"^",3)
|
|
. . . . S X=$$GET1^DIQ(4,ACQSITE,99)_"|"_$$GET1^DIQ(4,ACQSITE,.01)
|
|
. . . . S X=X_"|"_PRIMARY_"|"_ADMNSITE_"|"_LOCKTIME
|
|
. . . . S X=X_"|"_ISPECIDX_"|"_$$GET1^DIQ(2005.84,ISPECIDX,.01)_"|"_ADMNSPEC
|
|
. . . . S X=X_"|"_IPROCIDX_"|"_$$GET1^DIQ(2005.85,IPROCIDX,.01)_"|"_ADMNPROC
|
|
. . . . S X=X_"|"_USERPREF
|
|
. . . . S I=I+1,OUT(I+1)=X
|
|
. . . . Q
|
|
. . . Q
|
|
. . Q
|
|
. Q
|
|
S OUT(1)=I
|
|
Q
|
|
;
|
|
SETREAD(OUT,SITENUMB,ISPECIDX,IPROCIDX,USERPREF) ; MAG DICOM CON SET TELE READER
|
|
N ACQSITE,IENDUZ,IENSITE,IENSPEC,IENPROC,X
|
|
I '$G(SITENUMB) S OUT="-1, ACQUISITION SITE PARAMETER IS NOT DEFINED"
|
|
E I '$G(ISPECIDX) S OUT="-2, SPECIALTY PARAMETER IS NOT DEFINED"
|
|
E I '$G(IPROCIDX) S OUT="-3, PROCEDURE PARAMETER IS NOT DEFINED"
|
|
E I '$D(USERPREF) S OUT="-4, USER PREFERENCE SELCTION IS NOT DEFINED"
|
|
E I USERPREF'=0,USERPREF'=1 S OUT="-5, ILLEGAL VALUE FOR USER PREFERENCE: <<"_USERPREF_">>"
|
|
E D
|
|
. S IENDUZ=$O(^MAG(2006.5843,"B",DUZ,0))
|
|
. I 'IENDUZ S OUT="-6, USER (DUZ) #"_DUZ_" IS NOT DEFINED IN FILE 2006.5849" Q
|
|
. ;
|
|
. S ACQSITE=+$$ACQSITE(SITENUMB)
|
|
. I ACQSITE<0 S OUT="-7, ACQUISITION SITE #"_SITENUMB_" IS NOT DEFINED IN FILE 4" Q
|
|
. ;
|
|
. S IENSITE=$O(^MAG(2006.5843,IENDUZ,1,"B",ACQSITE,0))
|
|
. I 'IENSITE S OUT="-8, ACQUISITION SITE #"_ACQSITE_" IS NOT DEFINED IN FILE 2006.5849" Q
|
|
. ;
|
|
. S IENSPEC=$O(^MAG(2006.5843,IENDUZ,1,IENSITE,1,"B",ISPECIDX,0))
|
|
. I 'IENSPEC S OUT="-9, SPECIALTY #"_ISPECIDX_" IS NOT DEFINED IN FILE 2006.5849" Q
|
|
. ;
|
|
. S IENPROC=$O(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,"B",IPROCIDX,0))
|
|
. I 'IENPROC S OUT="-10, PROCEDURE #"_IPROCIDX_" IS NOT DEFINED IN FILE 2006.5849" Q
|
|
. ;
|
|
. I $D(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,IENPROC,0)) S X=^(0) D
|
|
. . I $P(X,"^",3)=USERPREF S OUT="2, USER PREFERENCE ALREADY SET"
|
|
. . E D
|
|
. . . S $P(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,IENPROC,0),"^",3)=USERPREF
|
|
. . . S OUT="1, USER PREFERENCE SET"
|
|
. . . Q
|
|
. . Q
|
|
. E S OUT="-10, PROCEDURE #"_IPROCIDX_" IS NOT DEFINED IN FILE 2006.5849"
|
|
. Q
|
|
Q
|
|
;
|
|
ACQSITE(SITENUMB) ; lookup an institution by the site number
|
|
N D,DIC,U,X,Y
|
|
S DIC="^DIC(4," ; INSTITUTION is file #4
|
|
S D="D" ; use the "D" cross-reference
|
|
S DIC(0)="X" ; only find the exact matching entry
|
|
S X=SITENUMB
|
|
D IX^DIC
|
|
Q Y
|