Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTIA1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTIA1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTIA1.m
r613 r623 1 MAGGTIA1 ;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 20 ADD ;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) 40 LOCK 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 ; 94 C1 ; 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 ; 153 CLEAN ; 154 D CLEAN^DILF 155 L -^MAG(2005,NEWIEN) 156 Q 157 RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text 158 S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1) 159 Q 160 ERR ; Error trap 161 S MAGRY="0^ERROR "_$$EC^%ZOSV 162 D @^%ZOSF("ERRTN") 163 Q 164 MAKENAME() ; 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 1 MAGGTIA1 ;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 19 ADD ;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) 39 LOCK 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 ; 96 C1 ; 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 ; 134 CLEAN ; 135 D CLEAN^DILF 136 L -^MAG(2005,NEWIEN) 137 Q 138 RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text 139 S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1) 140 Q 141 ERR ; Error trap 142 S MAGRY="0^ERROR "_$$EC^%ZOSV 143 D @^%ZOSF("ERRTN") 144 Q 145 MAKENAME() ; 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 TracChangeset
for help on using the changeset viewer.
