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

MAGDTR06.m

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