source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDIR9B.m@ 949

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1MAGDIR9B ;WOIFO/PMK - Read a DICOM image file ; 12 Oct 2005 8:21 AM
2 ;;3.0;IMAGING;**11,51,50**;26-May-2006
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 ;;
18 ; M2MB server
19 ;
20 ; Create an image entry in ^MAG(2005)
21 ;
22IMAGE() ; entry point from ^MAGDIR81 to create an image entry in ^MAG(2005)
23 N IMAGE ;---- image array for ^MAGGTIA
24 N IMAGECNT ;- counter of image in the group
25 N IMAGEPTR ;- value returned by ^MAGGTIA
26 ;
27 ; check that the group has right object type and is for the same person
28 I $P($G(^MAG(2005,MAGGP,0)),"^",6)'=11 D Q -101 ; fatal error
29 . D OBJECT^MAGDIRVE($T(+0),MAGGP)
30 . Q
31 ;
32 ; check that the group patient DFN matches the image patient DFN
33 I $P(^MAG(2005,MAGGP,0),"^",7)'=DFN D Q -102 ; fatal error
34 . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
35 . Q
36 ;
37 ; get the next file number and create the entry for this image
38 ;
39 S IMAGECNT=$P($G(^MAG(2005,MAGGP,1,0)),"^",4)+1 ; next image # in group
40 ;
41 K IMAGE
42 S IMAGE(1)=".01^"_PNAMEVAH_" "_DCMPID_" "_PROCDESC ; used in ^MAGDIR8
43 S IMAGE(2)="5^"_DFN
44 I $D(FILEDATA("SHORT DESCRIPTION")) D ; set in ^MAGDIR7F
45 . S IMAGE(3)="10^"_FILEDATA("SHORT DESCRIPTION")
46 . Q
47 E S IMAGE(3)="10^"_PROCDESC_" (#"_IMAGECNT_")" ; used in ^MAGDIR81
48 S IMAGE(4)="14^"_MAGGP
49 S IMAGE(5)="15^"_DATETIME
50 S IMAGE(6)="60^"_IMAGEUID
51 S IMAGE(7)=FILEDATA("EXTENSION") ; specify the image file extension
52 I $D(FILEDATA("ABSTRACT")) S IMAGE(8)=FILEDATA("ABSTRACT")
53 S IMAGE(9)="WRITE^PACS" ; select the PACS image write location
54 S IMAGE(10)="3^"_FILEDATA("OBJECT TYPE")
55 S IMAGE(11)="6^"_FILEDATA("MODALITY")
56 S IMAGE(12)="16^"_FILEDATA("PARENT FILE")
57 S IMAGE(13)="17^"_FILEDATA("PARENT IEN")
58 I $D(FILEDATA("PARENT FILE PTR")) S IMAGE(14)="18^"_FILEDATA("PARENT FILE PTR")
59 I $D(FILEDATA("RAD REPORT")) S IMAGE(15)="61^"_FILEDATA("RAD REPORT")
60 I $D(FILEDATA("RAD PROC PTR")) S IMAGE(16)="62^"_FILEDATA("RAD PROC PTR")
61 I MODPARMS["/" S IMAGE(17)="BIG^1" ; big file will be output
62 S IMAGE(18)="DICOMSN^"_SERINUMB ; series number
63 S IMAGE(19)="DICOMIN^"_IMAGNUMB ; image number
64 S IMAGE(20)=".05^"_INSTLOC
65 S IMAGE(21)="40^"_FILEDATA("PACKAGE")
66 S IMAGE(22)="41^"_$O(^MAG(2005.82,"B","CLIN",""))
67 S IMAGE(23)="42^"_FILEDATA("TYPE")
68 S IMAGE(24)="43^"_FILEDATA("PROC/EVENT")
69 S IMAGE(25)="44^"_FILEDATA("SPEC/SUBSPEC")
70 S IMAGE(26)="107^"_FILEDATA("ACQUISITION DEVICE")
71 S IMAGE(27)="251^"_FILEDATA("SOP CLASS POINTER")
72 S IMAGE(28)="253^"_SERIEUID
73 D ADD^MAGGTIA(.RETURN,.IMAGE)
74 ;
75 S IMAGEPTR=+RETURN
76 I 'IMAGEPTR D Q -103 ; fatal error
77 . K MSG
78 . S MSG(1)="IMAGE FILE CREATION ERROR:"
79 . S MSG(2)=$P(RETURN,"^",2,999)
80 . D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
81 . Q
82 ;
83 I IMAGEPTR<LASTIMG D Q -104 ; fatal last image pointer error
84 . D IMAGEPTR^MAGDIRVE($T(+0),IMAGEPTR,LASTIMG)
85 . Q
86 ;
87 S $P(RETURN,"^",4)=$$CHKPATH() ; hierarchal file patch check
88 ;
89 Q 0
90 ;
91CHKPATH() ; determine if the path is hierarchal (true) or not (false)
92 N D0,PATH
93 S D0="",PATH=$P(RETURN,"^",2)
94 I $D(^MAG(2005.2,"AC")) S D0=$O(^MAG(2005.2,"AC",PATH,""))
95 E D
96 . N PLACE
97 . S PLACE=""
98 . F S PLACE=$O(^MAG(2005.2,"E",PLACE)) Q:PLACE="" D Q:D0
99 . . S D0=$O(^MAG(2005.2,"E",PLACE,PATH,""))
100 . . Q
101 . Q
102 Q 'D0 ; network location file
103 ;
Note: See TracBrowser for help on using the repository browser.