source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTIA1.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 7.6 KB
Line 
1MAGGTIA1 ;WOIFO/GEK - RPC Call to Add Image File entry ; [ 06/20/2001 08:56 ]
2 ;;3.0;IMAGING;**21,8,59**;Nov 27, 2007;Build 20
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20ADD ;Now call Fileman to file the data
21 N GIEN,DIEN,NEWIEN,MAGGDA,X,Y
22 ;Because we delete the Image node on image deletion, we have to
23 ; check the last entry in Audit File, to see if it is greater than
24 ; last image in Image File.
25 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)
26 ; we know that MAGGIEN WILL contain the internal number.
27 ; after the call.
28 ;
29 I $G(MAGMOD) D Q ; WE'LL QUIT AFTER MODIFICATION
30 . D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
31 . S MAGRY="1^OK"
32 . ; Now, after UPDATE^DIE, we aren't getting the MAGGIEN array., We'll use MAGMOD
33 . D ACTION^MAGGTAU("MOD^"_$P(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$G(MAGMOD)) ; This is the Image IEN
34 ;
35 ; There are incidents of using an IEN from a deleted image
36 ; these next lines are to stop the problem.
37 S GIEN=$O(^MAG(2005," "),-1)+1
38 S DIEN=$O(^MAG(2005.1," "),-1)+1
39 S NEWIEN=$S(GIEN>DIEN:GIEN,1:DIEN)
40LOCK L +^MAG(2005,NEWIEN):0 E S NEWIEN=NEWIEN+1 G LOCK
41 I $D(^MAG(2005,NEWIEN)) L -^MAG(2005,NEWIEN) S NEWIEN=NEWIEN+1 G LOCK
42 S MAGGIEN(1)=NEWIEN
43 D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
44 ;
45 I '$G(MAGGIEN(1)) D S MAGRY=MAGERR Q
46 . S MAGERR="0^ERROR Creating new Image File Entry "
47 . I $D(DIERR) D RTRNERR(.MAGERR)
48 . D CLEAN
49 ;
50 S MAGGDA=MAGGIEN(1)
51 ;
52 D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
53 ;
54 ; IF a group, Modify GROUP PARENT in each Group Object and QUIT
55 ; we'll do this by hand, Else it'll take forever.
56 ; we Return the IEN with NO Filename. Groups don't get Filename
57 ;
58 I MAGGR S MAGRY=MAGGDA_U,Z="" D G C1
59 . F S Z=$O(MAGGR(Z)) Q:Z="" S $P(^MAG(2005,Z,0),U,10)=MAGGDA
60 . D CLEAN
61 ;
62 S X=$G(MAGGFDA(2005,"+1,",14)) I +X D
63 . ; If here: This image is a member of a Group
64 . ; -Modify the Group Parent, add DA to it's group
65 . ; -Also set 'Series Number' and 'Image Number' if 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 ; Now get the Image file name. DOS FILE name
75 ; The ENTRY in Image File has been made, if any errors from here on
76 ; then we have to delete the image entry.
77 I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) G C1
78 K MAGGFDA
79 S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGGEXT)) I 'X D S MAGRY=MAGERR Q
80 . S MAGERR=X
81 . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
82 . K DA,DIC,DIK
83 . D CLEAN
84 S MAGGFNM=$P(X,U,2),Y=MAGGDA_","
85 S MAGGFDA(2005,Y,1)=MAGGFNM
86 D UPDATE^DIE("","MAGGFDA","","MAGGXE")
87 ; shouldn't have an error just editing one entry, but just in case.
88 I $D(DIERR) D S MAGRY=MAGERR Q
89 . D RTRNERR(.MAGERR)
90 . S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
91 . K DA,DIC,DIK
92 . D CLEAN
93 ;
94C1 ; we jump here if we already had a Filename sent
95 K MAGGFDA
96 ; New Index Field Check. If this entry doesn't have the Index fields introduced
97 ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values.
98 ;
99 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry.
100 I '$D(^MAG(2005,MAGGDA,40)) D
101 . N INDXD
102 . D GENIEN^MAGXCVI(MAGGDA,.INDXD)
103 . S ^MAG(2005,MAGGDA,40)=INDXD
104 . S ^MAGIXCVT(2006.96,MAGGDA)=2 ; Flag. Says fields were converted Patch 59
105 . ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
106 . D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
107 . D ENTRY^MAGLOG("INDEX-ALL",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
108 . Q
109 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
110 I '$P(^MAG(2005,MAGGDA,40),"^",3) D
111 . N INDXD,OLD40,N40
112 . S (N40,OLD40)=^MAG(2005,MAGGDA,40)
113 . D GENIEN^MAGXCVI(MAGGDA,.INDXD)
114 . ; If Origin doesn't exist in existing, this will put V in.
115 . I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
116 . ; We're not changing existing values of Spec,Proc or Origin
117 . F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J)
118 . ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
119 . I '$$VALINDEX^MAGGSIV1(.X,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S $P(N40,"^",4,5)=$P(OLD40,"^",4,5)
120 . S ^MAG(2005,MAGGDA,40)=N40
121 . D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
122 . D ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
123 . Q
124 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
125 ;** IT IS DONE IN A SEPERATE CALL
126 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on
127 ;** the workstation
128 ;
129 ; Queue it to be copied to Jukebox.
130 ; CREATE ABSTRACT
131 ; visn15 ADDED $$DA2PLCA to resolve the Image's current PLACE
132 I $G(MAGGABS)="YES" S X=$$ABSTRACT^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"A"))
133 ; RESTORE AFTER GLOBAL SETUP
134 I $G(MAGGJB)="YES" S X=$$JUKEBOX^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"F"))
135 ; Code for setting a Queue to Copy BIG to JUKEBOX
136 ;
137 ; We return the IEN ^ DRIVE:DIR ^ FILE.EXT
138 ; example: 487^C:\IMAGE\^DC000487.TIF
139 ; The calling routine is responsible for renaming/naming the file
140 ; to the returned DRIVE:\DIR\FILENAME.EXT
141 ; 4/23/98 to include hierarchical directory structure -- PMK
142 ;
143 I 'MAGGR D
144 . S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
145 . S MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
146 . ; For now, BIG files are in same directory as FullRes (or PACS) file
147 . I $G(MAGBIG) D
148 . . S X=$P(MAGGFNM,".",1)_".BIG"
149 . . S MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X
150 . . Q
151 . Q
152 ;
153CLEAN ;
154 D CLEAN^DILF
155 L -^MAG(2005,NEWIEN)
156 Q
157RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
158 S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
159 Q
160ERR ; Error trap
161 S MAGRY="0^ERROR "_$$EC^%ZOSV
162 D @^%ZOSF("ERRTN")
163 Q
164MAKENAME() ; MAGGFDA exists so get info from that.
165 ; We'll make NAME (.01) with PATIENT NAME SSN
166 ; DOCUMENT Imaging was making name of
167 ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
168 N Z,ZT,ZNAME,ZSSN,ZDESC
169 ; GEK 10/10/2000
170 ; Modifying this procedure to make same name for all Image types
171 ; The name will be (first 18 chars of patient Name) _ SSN
172 I $D(MAGGFDA(2005,"+1,",10)) S ZDESC=$E(MAGGFDA(2005,"+1,",10),1,30)
173 I $D(MAGGFDA(2005,"+1,",5)) D
174 . S X=MAGGFDA(2005,"+1,",5)
175 . S ZNAME=$P(^DPT(X,0),U),ZSSN=$P(^DPT(X,0),U,9)
176 ;
177 ; For all Images the name is first 18 characters of patient name
178 ; concatenated with SSN. If No patient name is sent, well make
179 ; the name from the short desc.
180 I $D(ZNAME) S Z=$E(ZNAME,1,18)_" "_ZSSN
181 E S Z=ZDESC
182 Q Z
Note: See TracBrowser for help on using the repository browser.