| 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
|
|---|
