MAGDTR06 ;WOIFO/PMK - Read a DICOM image file ; 29 Sep 2008 10:51 AM
;;3.0;IMAGING;**46,54**;03-July-2009;;Build 1424
;; 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 PRIMARY=$$GET1^DIQ(4,PRIMARY,99) ; use station number
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)
. . S PRIMARY=$$GET1^DIQ(4,PRIMARY,99) ; use station number
. . ; 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,STATNUMB,ISPECIDX,IPROCIDX,USERPREF) ; MAG DICOM CON SET TELE READER
N ACQSITE,IENDUZ,IENSITE,IENSPEC,IENPROC,X
I '$G(STATNUMB) S OUT="-1, ACQUISITION STATION NUMBER 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(STATNUMB)
. I ACQSITE<0 S OUT="-7, ACQUISITION STATION NUMBER "_STATNUMB_" 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(STATNUMB) ; lookup an institution by the station 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=STATNUMB
D IX^DIC
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDTR06 5085 printed Dec 13, 2024@02:02:11 Page 2
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
+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 ;;
GETSITES(OUT) ; MAG DICOM CON UNREAD ACQ SITES
+1 NEW ACQSITE,ADMNSITE,I,J,LOCKTIME,PRIMARY,X
+2 SET J=0
+3 SET I=0
FOR
SET I=$ORDER(^MAG(2006.5842,I))
if 'I
QUIT
SET X=^(I,0)
DO GETSITE1
+4 SET OUT(1)=J
+5 QUIT
+6 ;
GETSITE1 ;
+1 SET J=J+1
+2 SET ACQSITE=$PIECE(X,"^",1)
SET PRIMARY=$PIECE(X,"^",2)
+3 ; use station number
SET PRIMARY=$$GET1^DIQ(4,PRIMARY,99)
+4 SET ADMNSITE=$PIECE(X,"^",3)
SET LOCKTIME=$PIECE(X,"^",4)
+5 SET OUT(J+1)=$$GET1^DIQ(4,ACQSITE,99)_"|"_$$GET1^DIQ(4,ACQSITE,.01)_"|"_PRIMARY_"|"_ADMNSITE_"|"_LOCKTIME
+6 QUIT
+7 ;
GETREAD(OUT) ; MAG DICOM CON GET TELE READER
+1 NEW ACQSITE,I,IPROCIDX,ISPECIDX,LOCKTIME,PRIMARY,XACQSITE,X,XDUZ,XPROCIDX,XSPECIDX
+2 NEW ADMNPROC,ADMNSITE,ADMNSPEC,USERPREF
+3 ;
+4 SET (I,XDUZ)=0
+5 FOR
SET XDUZ=$ORDER(^MAG(2006.5843,"B",DUZ,XDUZ))
if 'XDUZ
QUIT
SET XACQSITE=0
Begin DoDot:1
+6 FOR
SET XACQSITE=$ORDER(^MAG(2006.5843,XDUZ,1,XACQSITE))
if 'XACQSITE
QUIT
Begin DoDot:2
+7 SET X=^MAG(2006.5843,XDUZ,1,XACQSITE,0)
+8 SET ACQSITE=$PIECE(X,"^",1)
SET ADMNSITE=$PIECE(X,"^",2)
+9 SET PRIMARY=$PIECE(^MAG(2006.5842,ACQSITE,0),"^",2)
SET LOCKTIME=$PIECE(^(0),"^",4)
+10 ; use station number
SET PRIMARY=$$GET1^DIQ(4,PRIMARY,99)
+11 ; an inactive site in file 2006.5842 overrides the active for the user
+12 ; site is not active
IF ADMNSITE
SET ADMNSITE=$PIECE(^MAG(2006.5842,ACQSITE,0),"^",3)
+13 SET XSPECIDX=0
+14 FOR
SET XSPECIDX=$ORDER(^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX))
if 'XSPECIDX
QUIT
Begin DoDot:3
+15 SET X=^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,0)
+16 SET ISPECIDX=$PIECE(X,"^",1)
SET ADMNSPEC=$PIECE(X,"^",2)
+17 SET XPROCIDX=0
+18 FOR
SET XPROCIDX=$ORDER(^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,1,XPROCIDX))
if 'XPROCIDX
QUIT
Begin DoDot:4
+19 SET X=^MAG(2006.5843,XDUZ,1,XACQSITE,1,XSPECIDX,1,XPROCIDX,0)
+20 SET IPROCIDX=$PIECE(X,"^",1)
SET ADMNPROC=$PIECE(X,"^",2)
SET USERPREF=$PIECE(X,"^",3)
+21 SET X=$$GET1^DIQ(4,ACQSITE,99)_"|"_$$GET1^DIQ(4,ACQSITE,.01)
+22 SET X=X_"|"_PRIMARY_"|"_ADMNSITE_"|"_LOCKTIME
+23 SET X=X_"|"_ISPECIDX_"|"_$$GET1^DIQ(2005.84,ISPECIDX,.01)_"|"_ADMNSPEC
+24 SET X=X_"|"_IPROCIDX_"|"_$$GET1^DIQ(2005.85,IPROCIDX,.01)_"|"_ADMNPROC
+25 SET X=X_"|"_USERPREF
+26 SET I=I+1
SET OUT(I+1)=X
+27 QUIT
End DoDot:4
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 SET OUT(1)=I
+32 QUIT
+33 ;
SETREAD(OUT,STATNUMB,ISPECIDX,IPROCIDX,USERPREF) ; MAG DICOM CON SET TELE READER
+1 NEW ACQSITE,IENDUZ,IENSITE,IENSPEC,IENPROC,X
+2 IF '$GET(STATNUMB)
SET OUT="-1, ACQUISITION STATION NUMBER PARAMETER IS NOT DEFINED"
+3 IF '$TEST
IF '$GET(ISPECIDX)
SET OUT="-2, SPECIALTY PARAMETER IS NOT DEFINED"
+4 IF '$TEST
IF '$GET(IPROCIDX)
SET OUT="-3, PROCEDURE PARAMETER IS NOT DEFINED"
+5 IF '$TEST
IF '$DATA(USERPREF)
SET OUT="-4, USER PREFERENCE SELCTION IS NOT DEFINED"
+6 IF '$TEST
IF USERPREF'=0
IF USERPREF'=1
SET OUT="-5, ILLEGAL VALUE FOR USER PREFERENCE: <<"_USERPREF_">>"
+7 IF '$TEST
Begin DoDot:1
+8 SET IENDUZ=$ORDER(^MAG(2006.5843,"B",DUZ,0))
+9 IF 'IENDUZ
SET OUT="-6, USER (DUZ) #"_DUZ_" IS NOT DEFINED IN FILE 2006.5849"
QUIT
+10 ;
+11 SET ACQSITE=+$$ACQSITE(STATNUMB)
+12 IF ACQSITE<0
SET OUT="-7, ACQUISITION STATION NUMBER "_STATNUMB_" IS NOT DEFINED IN FILE 4"
QUIT
+13 ;
+14 SET IENSITE=$ORDER(^MAG(2006.5843,IENDUZ,1,"B",ACQSITE,0))
+15 IF 'IENSITE
SET OUT="-8, ACQUISITION SITE #"_ACQSITE_" IS NOT DEFINED IN FILE 2006.5849"
QUIT
+16 ;
+17 SET IENSPEC=$ORDER(^MAG(2006.5843,IENDUZ,1,IENSITE,1,"B",ISPECIDX,0))
+18 IF 'IENSPEC
SET OUT="-9, SPECIALTY #"_ISPECIDX_" IS NOT DEFINED IN FILE 2006.5849"
QUIT
+19 ;
+20 SET IENPROC=$ORDER(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,"B",IPROCIDX,0))
+21 IF 'IENPROC
SET OUT="-10, PROCEDURE #"_IPROCIDX_" IS NOT DEFINED IN FILE 2006.5849"
QUIT
+22 ;
+23 IF $DATA(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,IENPROC,0))
SET X=^(0)
Begin DoDot:2
+24 IF $PIECE(X,"^",3)=USERPREF
SET OUT="2, USER PREFERENCE ALREADY SET"
+25 IF '$TEST
Begin DoDot:3
+26 SET $PIECE(^MAG(2006.5843,IENDUZ,1,IENSITE,1,IENSPEC,1,IENPROC,0),"^",3)=USERPREF
+27 SET OUT="1, USER PREFERENCE SET"
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 IF '$TEST
SET OUT="-10, PROCEDURE #"_IPROCIDX_" IS NOT DEFINED IN FILE 2006.5849"
+31 QUIT
End DoDot:1
+32 QUIT
+33 ;
ACQSITE(STATNUMB) ; lookup an institution by the station number
+1 NEW D,DIC,U,X,Y
+2 ; INSTITUTION is file #4
SET DIC="^DIC(4,"
+3 ; use the "D" cross-reference
SET D="D"
+4 ; only find the exact matching entry
SET DIC(0)="X"
+5 SET X=STATNUMB
+6 DO IX^DIC
+7 QUIT Y
