source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTIA1.m@ 1270

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

revised back to 6/30/08 version

File size: 6.4 KB
Line 
1MAGGTIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 06/20/2001 08:56 ]
2 ;;3.0;IMAGING;**21,8**;Sep 15, 2004
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 Q
19ADD ;Now call Fileman to file the data
20 N GIEN,DIEN,NEWIEN,MAGGDA,X,Y
21 ;Because we delete the Image node on image deletion, we have to
22 ; check the last entry in Audit File, to see if it is greater than
23 ; last image in Image File.
24 I ($O(^MAG(2005,"A"),-1)<$O(^MAG(2005.1,"A"),-1)) S $P(^MAG(2005,0),U,3)=$O(^MAG(2005.1,"A"),-1)
25 ; we know that MAGGIEN WILL contain the internal number.
26 ; after the call.
27 ;
28 I $G(MAGMOD) D Q ; WE'LL QUIT AFTER MODIFICATION
29 . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
30 . S MAGRY="1^OK"
31 . ; Now, after UPDATE^DIE, we aren't getting the MAGGIEN array., We'll use MAGMOD
32 . D ACTION^MAGGTAU("MOD^"_$P(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$G(MAGMOD)) ; This is the Image IEN
33 ;
34 ; There are incidents of using an IEN from a deleted image (still)
35 ; these next lines are TESTING for now. To stop the problem.
36 S GIEN=$O(^MAG(2005," "),-1)+1
37 S DIEN=$O(^MAG(2005.1," "),-1)+1
38 S NEWIEN=$S(GIEN>DIEN:GIEN,1:DIEN)
39LOCK L +^MAG(2005,NEWIEN):0 E S NEWIEN=NEWIEN+1 G LOCK
40 I $D(^MAG(2005,NEWIEN)) L -^MAG(2005,NEWIEN) S NEWIEN=NEWIEN+1 G LOCK
41 S MAGGIEN(1)=NEWIEN
42 D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
43 ;
44 I '$G(MAGGIEN(1)) D S MAGRY=MAGERR Q
45 . S MAGERR="0^ERROR Creating new Image File Entry "
46 . I $D(DIERR) D RTRNERR(.MAGERR)
47 . D CLEAN
48 ;
49 S MAGGDA=MAGGIEN(1)
50 ;
51 D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
52 ;
53 ; IF a group, Modify GROUP PARENT in each Group Object and QUIT
54 ; we'll do this by hand, Else it'll take forever.
55 ; we Return the IEN with NO Filename. Groups don't get Filename
56 ;
57 I MAGGR S MAGRY=MAGGDA_U,Z="" D Q
58 . F S Z=$O(MAGGR(Z)) Q:Z="" S $P(^MAG(2005,Z,0),U,10)=MAGGDA
59 . D CLEAN
60 ;
61 S X=$G(MAGGFDA(2005,"+1,",14)) I +X D
62 . ; We're here beceause this image is a member of a Group
63 . ; so we will modify the Group Parent, adding this to it's group
64 . ; HERE we will also send the 'Series Number' and 'Image Number' if
65 . ; they exist;
66 . K MAGGFDA
67 . S Y="+2,"_X_","
68 . S MAGGFDA(2005.04,Y,.01)=MAGGDA
69 . ; GEK 4/4/00 ADDED $L( we were dying on "0"
70 . I $L($G(MAGDCMSN)) S MAGGFDA(2005.04,Y,1)=MAGDCMSN
71 . I $L($G(MAGDCMIN)) S MAGGFDA(2005.04,Y,2)=MAGDCMIN
72 . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
73 ;
74 ;
75 ;
76 ; now get the Image file name. DOS FILE name
77 ; ENTRY in Image File has been made, if any errors from here on
78 ; then we have to delete the image entry.
79 I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) G C1
80 K MAGGFDA
81 S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGGEXT)) I 'X D S MAGRY=MAGERR Q
82 . S MAGERR=X
83 . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
84 . K DA,DIC,DIK
85 . D CLEAN
86 S MAGGFNM=$P(X,U,2),Y=MAGGDA_","
87 S MAGGFDA(2005,Y,1)=MAGGFNM
88 D UPDATE^DIE("","MAGGFDA","","MAGGXE")
89 ; shouldn't have an error just editing one entry, but just in case.
90 I $D(DIERR) D S MAGRY=MAGERR Q
91 . D RTRNERR(.MAGERR)
92 . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
93 . K DA,DIC,DIK
94 . D CLEAN
95 ;
96C1 ; we jump here if we already had a Filename sent
97 ;
98 K MAGGFDA
99 ; New Index Field Check. If this entry doesn't have the Index fields introduced
100 ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values.
101 ;
102 ;-This is being deferred to a later patch.
103 ;-I '$D(^MAG(2005,MAGGDA,40)) D
104 ;-. D ONE^MAGSCNVI(MAGGDA)
105 ;-. D ACTION^MAGGTAU("DFTINDX^^"_MAGGDA)
106 ;
107 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
108 ;** IT IS DONE IN A SEPERATE CALL
109 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on
110 ;** the workstation
111 ;
112 ; Queue it to be copied to Jukebox.
113 ; CREATE ABSTRACT
114 ; visn15 ADDED $$DA2PLCA to resolve the Image's current PLACE
115 I $G(MAGGABS)="YES" S X=$$ABSTRACT^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"A"))
116 ; RESTORE AFTER GLOBAL SETUP
117 I $G(MAGGJB)="YES" S X=$$JUKEBOX^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"F"))
118 ; Code for setting a Queue to Copy BIG to JUKEBOX
119 ;
120 ; We return the IEN ^ DRIVE:DIR ^ FILE.EXT
121 ; i.e 487^C:\IMAGE\^DC000487.TIF
122 ; The calling routine is responsible for renaming/naming the file
123 ; to the returned DRIVE:\DIR\FILENAME.EXT
124 ; Modified 4/23/98 to include hierarchial directory structure -- PMK
125 ;
126 S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
127 S MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
128 ; For now, BIG files are in same directory as FullRes (or PACS) file
129 I $G(MAGBIG) D
130 . S X=$P(MAGGFNM,".",1)_".BIG"
131 . S MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X
132 . Q
133 ;
134CLEAN ;
135 D CLEAN^DILF
136 L -^MAG(2005,NEWIEN)
137 Q
138RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
139 S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
140 Q
141ERR ; Error trap
142 S MAGRY="0^ERROR "_$$EC^%ZOSV
143 D @^%ZOSF("ERRTN")
144 Q
145MAKENAME() ; MAGGFDA exists so get info from that.
146 ; We'll make NAME (.01) with PATIENT NAME SSN
147 ; DOCUMENT Imaging was making name of
148 ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
149 N Z,ZT,ZNAME,ZSSN,ZDESC
150 ; GEK 10/10/2000
151 ; Modifying this procedure to make same name for all Image types
152 ; The name will be (first 18 chars of patient Name) _ SSN
153 I $D(MAGGFDA(2005,"+1,",10)) S ZDESC=$E(MAGGFDA(2005,"+1,",10),1,30)
154 I $D(MAGGFDA(2005,"+1,",5)) D
155 . S X=MAGGFDA(2005,"+1,",5)
156 . S ZNAME=$P(^DPT(X,0),U),ZSSN=$P(^DPT(X,0),U,9)
157 ;
158 ; For all Images the name is first 18 characters of patient name
159 ; concatenated with SSN. If No patient name is sent, well make
160 ; the name from the short desc.
161 I $D(ZNAME) S Z=$E(ZNAME,1,18)_" "_ZSSN
162 E S Z=ZDESC
163 Q Z
Note: See TracBrowser for help on using the repository browser.