MAGGTIA1 ;WOIFO/GEK/SG/NST - RPC Call to Add Image File entry ; Dec 05, 2018@1:42pm
;;3.0;IMAGING;**21,8,59,93,201,221**;Dec 02, 2009;Build 163
;;Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
ADD ;Now call Fileman to file the data
N NEWIEN,MAGGDA,X,Y
;~~~ Delete this comment and the following line of code when
; the IMAGE AUDIT file (#2005.1) is completely eliminated.
; Because we delete the Image node on image deletion, we have to
; check the last entry in Audit File, to see if it is greater
;~~~ than the last image in the Image File.
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)
; we know that MAGGIEN WILL contain the internal number.
; after the call.
;
I $G(MAGMOD) D Q ; WE'LL QUIT AFTER MODIFICATION
. D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
. S MAGRY="1^OK"
. ; Now, after UPDATE^DIE, we aren't getting the MAGGIEN array., We'll use MAGMOD
. D ACTION^MAGGTAU("MOD^"_$P(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$G(MAGMOD)) ; This is the Image IEN
;
S (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12() ; SG - MAG*3*93
D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
;
I '$G(MAGGIEN(1)) D S MAGRY=MAGERR Q
. S MAGERR="0^ERROR Creating new Image File Entry "
. I $D(DIERR) D RTRNERR(.MAGERR)
. D CLEAN
;
S MAGGDA=MAGGIEN(1)
;
D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
;
; IF a group, Modify GROUP PARENT in each Group Object and QUIT
; we'll do this by hand, Else it'll take forever.
; we Return the IEN with NO Filename. Groups don't get Filename
;
I MAGGR S MAGRY=MAGGDA_U,Z="" D G C1
. F S Z=$O(MAGGR(Z)) Q:Z="" S $P(^MAG(2005,Z,0),U,10)=MAGGDA
. D CLEAN
;
S X=$G(MAGGFDA(2005,"+1,",14)) I +X D
. ; If here: This image is a member of a Group
. ; -Modify the Group Parent, add DA to it's group
. ; -Also set 'Series Number' and 'Image Number' if they exist;
. K MAGGFDA
. S Y="+2,"_X_","
. S MAGGFDA(2005.04,Y,.01)=MAGGDA
. ; GEK 4/4/00 ADDED $L( we were dying on "0"
. I $L($G(MAGDCMSN)) S MAGGFDA(2005.04,Y,1)=MAGDCMSN
. I $L($G(MAGDCMIN)) S MAGGFDA(2005.04,Y,2)=MAGDCMIN
. D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
;
; Now get the Image file name. DOS FILE name
; The ENTRY in Image File has been made, if any errors from here on
; then we have to delete the image entry.
I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1) G C1
K MAGGFDA
S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGGEXT)) I 'X D S MAGRY=MAGERR Q
. S MAGERR=X
. S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
. K DA,DIC,DIK
. D CLEAN
S MAGGFNM=$P(X,U,2),Y=MAGGDA_","
S MAGGFDA(2005,Y,1)=MAGGFNM
D UPDATE^DIE("","MAGGFDA","","MAGGXE")
; shouldn't have an error just editing one entry, but just in case.
I $D(DIERR) D S MAGRY=MAGERR Q
. D RTRNERR(.MAGERR)
. S DA=MAGGDA,DIK="^MAG(2005," D ^DIK
. K DA,DIC,DIK
. D CLEAN
;
C1 ; we jump here if we already had a Filename sent
K MAGGFDA
; New Index Field Check. If this entry doesn't have the Index fields introduced
; in 3.0.8 then we use the Patch 17 conversion API call to generate default values.
;
;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry.
I '$D(^MAG(2005,MAGGDA,40)) D
. N INDXD
. D GENIEN^MAGXCVI(MAGGDA,.INDXD)
. S ^MAG(2005,MAGGDA,40)=INDXD
. S ^MAGIXCVT(2006.96,MAGGDA)=2 ; Flag. Says fields were converted Patch 59
. ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
. D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
. D ENTRY^MAGLOG("INDEX-ALL",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
. Q
;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
I '$P(^MAG(2005,MAGGDA,40),"^",3) D
. N INDXD,J,OLD40,N40
. S (N40,OLD40)=^MAG(2005,MAGGDA,40)
. D GENIEN^MAGXCVI(MAGGDA,.INDXD)
. ; If Origin doesn't exist in existing, this will put V in.
. I $P(INDXD,"^",6)="" S $P(INDXD,"^",6)="V"
. ; We're not changing existing values of Spec,Proc or Origin
. F J=1:1:6 I '$L($P(N40,"^",J)) S $P(N40,"^",J)=$P(INDXD,"^",J)
. ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
. I '$$VALINDEX^MAGGSIV1(.X,$P(N40,"^",3),$P(N40,"^",5),$P(N40,"^",4)) S $P(N40,"^",4,5)=$P(OLD40,"^",4,5)
. S ^MAG(2005,MAGGDA,40)=N40
. D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
. D ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$P(^MAG(2005,MAGGDA,0),"^",7),1)
. Q
;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
;** IT IS DONE IN A SEPERATE CALL
;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on
;** the workstation
;
; Queue it to be copied to Jukebox.
; CREATE ABSTRACT
; visn15 ADDED $$DA2PLCA to resolve the Image's current PLACE
I $G(MAGGABS)="YES" S X=$$ABSTRACT^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"A"))
; RESTORE AFTER GLOBAL SETUP
I $G(MAGGJB)="YES" S X=$$JUKEBOX^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"F"))
; Code for setting a Queue to Copy BIG to JUKEBOX
;
; We return the IEN ^ DRIVE:DIR ^ FILE.EXT
; example: 487^C:\IMAGE\^DC000487.TIF
; The calling routine is responsible for renaming/naming the file
; to the returned DRIVE:\DIR\FILENAME.EXT
; 4/23/98 to include hierarchical directory structure -- PMK
;
I 'MAGGR D
. S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
. S MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
. ; For now, BIG files are in same directory as FullRes (or PACS) file
. I $G(MAGBIG) D
. . S X=$P(MAGGFNM,".",1)_".BIG"
. . S MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X
. . Q
. Q
;
N MAGOUT
D NWI2005^MAGNWRK1(.MAGOUT,MAGGDA) ; add a new storage work item
;
CLEAN ;
D CLEAN^DILF
L -^MAG(2005,NEWIEN)
Q
RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
S ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
Q
ERR ; Error trap
S MAGRY="0^ERROR "_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q
MAKENAME() ; MAGGFDA exists so get info from that.
; We'll make NAME (.01) with PATIENT NAME SSN
; DOCUMENT Imaging was making name of
; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
N Z,ZT,ZNAME,ZSSN,ZDESC
; GEK 10/10/2000
; Modifying this procedure to make same name for all Image types
; The name will be (first 18 chars of patient Name) _ SSN
I $D(MAGGFDA(2005,"+1,",10)) S ZDESC=$E(MAGGFDA(2005,"+1,",10),1,30)
I $D(MAGGFDA(2005,"+1,",5)) D
. S X=MAGGFDA(2005,"+1,",5)
. S ZNAME=$P(^DPT(X,0),U),ZSSN=$P(^DPT(X,0),U,9)
;
; For all Images the name is first 18 characters of patient name
; concatenated with SSN. If No patient name is sent, well make
; the name from the short desc.
I $D(ZNAME) S Z=$E(ZNAME,1,18)_" "_ZSSN
E S Z=ZDESC
Q Z
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTIA1 7896 printed Sep 23, 2025@19:39:11 Page 2
MAGGTIA1 ;WOIFO/GEK/SG/NST - RPC Call to Add Image File entry ; Dec 05, 2018@1:42pm
+1 ;;3.0;IMAGING;**21,8,59,93,201,221**;Dec 02, 2009;Build 163
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+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 QUIT
ADD ;Now call Fileman to file the data
+1 NEW NEWIEN,MAGGDA,X,Y
+2 ;~~~ Delete this comment and the following line of code when
+3 ; the IMAGE AUDIT file (#2005.1) is completely eliminated.
+4 ; Because we delete the Image node on image deletion, we have to
+5 ; check the last entry in Audit File, to see if it is greater
+6 ;~~~ than the last image in the Image File.
+7 IF ($ORDER(^MAG(2005,"A"),-1)<$ORDER(^MAG(2005.1,"A"),-1))
SET $PIECE(^MAG(2005,0),U,3)=$ORDER(^MAG(2005.1,"A"),-1)
+8 ; we know that MAGGIEN WILL contain the internal number.
+9 ; after the call.
+10 ;
+11 ; WE'LL QUIT AFTER MODIFICATION
IF $GET(MAGMOD)
Begin DoDot:1
+12 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
+13 SET MAGRY="1^OK"
+14 ; Now, after UPDATE^DIE, we aren't getting the MAGGIEN array., We'll use MAGMOD
+15 ; This is the Image IEN
DO ACTION^MAGGTAU("MOD^"_$PIECE(^MAG(2005,+MAGMOD,0),U,7)_"^"_+$GET(MAGMOD))
End DoDot:1
QUIT
+16 ;
+17 ; SG - MAG*3*93
SET (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12()
+18 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
+19 ;
+20 IF '$GET(MAGGIEN(1))
Begin DoDot:1
+21 SET MAGERR="0^ERROR Creating new Image File Entry "
+22 IF $DATA(DIERR)
DO RTRNERR(.MAGERR)
+23 DO CLEAN
End DoDot:1
SET MAGRY=MAGERR
QUIT
+24 ;
+25 SET MAGGDA=MAGGIEN(1)
+26 ;
+27 DO ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
+28 ;
+29 ; IF a group, Modify GROUP PARENT in each Group Object and QUIT
+30 ; we'll do this by hand, Else it'll take forever.
+31 ; we Return the IEN with NO Filename. Groups don't get Filename
+32 ;
+33 IF MAGGR
SET MAGRY=MAGGDA_U
SET Z=""
Begin DoDot:1
+34 FOR
SET Z=$ORDER(MAGGR(Z))
if Z=""
QUIT
SET $PIECE(^MAG(2005,Z,0),U,10)=MAGGDA
+35 DO CLEAN
End DoDot:1
GOTO C1
+36 ;
+37 SET X=$GET(MAGGFDA(2005,"+1,",14))
IF +X
Begin DoDot:1
+38 ; If here: This image is a member of a Group
+39 ; -Modify the Group Parent, add DA to it's group
+40 ; -Also set 'Series Number' and 'Image Number' if they exist;
+41 KILL MAGGFDA
+42 SET Y="+2,"_X_","
+43 SET MAGGFDA(2005.04,Y,.01)=MAGGDA
+44 ; GEK 4/4/00 ADDED $L( we were dying on "0"
+45 IF $LENGTH($GET(MAGDCMSN))
SET MAGGFDA(2005.04,Y,1)=MAGDCMSN
+46 IF $LENGTH($GET(MAGDCMIN))
SET MAGGFDA(2005.04,Y,2)=MAGDCMIN
+47 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
End DoDot:1
+48 ;
+49 ; Now get the Image file name. DOS FILE name
+50 ; The ENTRY in Image File has been made, if any errors from here on
+51 ; then we have to delete the image entry.
+52 IF $DATA(MAGGFDA(2005,"+1,",1))
SET MAGGFNM=MAGGFDA(2005,"+1,",1)
GOTO C1
+53 KILL MAGGFDA
+54 SET X=$$DA2NAME^MAGGTU1(MAGGDA,$GET(MAGGEXT))
IF 'X
Begin DoDot:1
+55 SET MAGERR=X
+56 SET DA=MAGGDA
SET DIK="^MAG(2005,"
DO ^DIK
+57 KILL DA,DIC,DIK
+58 DO CLEAN
End DoDot:1
SET MAGRY=MAGERR
QUIT
+59 SET MAGGFNM=$PIECE(X,U,2)
SET Y=MAGGDA_","
+60 SET MAGGFDA(2005,Y,1)=MAGGFNM
+61 DO UPDATE^DIE("","MAGGFDA","","MAGGXE")
+62 ; shouldn't have an error just editing one entry, but just in case.
+63 IF $DATA(DIERR)
Begin DoDot:1
+64 DO RTRNERR(.MAGERR)
+65 SET DA=MAGGDA
SET DIK="^MAG(2005,"
DO ^DIK
+66 KILL DA,DIC,DIK
+67 DO CLEAN
End DoDot:1
SET MAGRY=MAGERR
QUIT
+68 ;
C1 ; we jump here if we already had a Filename sent
+1 KILL MAGGFDA
+2 ; New Index Field Check. If this entry doesn't have the Index fields introduced
+3 ; in 3.0.8 then we use the Patch 17 conversion API call to generate default values.
+4 ;
+5 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry.
+6 IF '$DATA(^MAG(2005,MAGGDA,40))
Begin DoDot:1
+7 NEW INDXD
+8 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
+9 SET ^MAG(2005,MAGGDA,40)=INDXD
+10 ; Flag. Says fields were converted Patch 59
SET ^MAGIXCVT(2006.96,MAGGDA)=2
+11 ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
+12 ;_"$$"_MAGGFDA(2005,"+1,",108))
DO ACTION^MAGGTAU("INDEX-ALL^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA)
+13 DO ENTRY^MAGLOG("INDEX-ALL",DUZ,MAGGDA,"P59",$PIECE(^MAG(2005,MAGGDA,0),"^",7),1)
+14 QUIT
End DoDot:1
+15 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
+16 IF '$PIECE(^MAG(2005,MAGGDA,40),"^",3)
Begin DoDot:1
+17 NEW INDXD,J,OLD40,N40
+18 SET (N40,OLD40)=^MAG(2005,MAGGDA,40)
+19 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
+20 ; If Origin doesn't exist in existing, this will put V in.
+21 IF $PIECE(INDXD,"^",6)=""
SET $PIECE(INDXD,"^",6)="V"
+22 ; We're not changing existing values of Spec,Proc or Origin
+23 FOR J=1:1:6
IF '$LENGTH($PIECE(N40,"^",J))
SET $PIECE(N40,"^",J)=$PIECE(INDXD,"^",J)
+24 ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
+25 IF '$$VALINDEX^MAGGSIV1(.X,$PIECE(N40,"^",3),$PIECE(N40,"^",5),$PIECE(N40,"^",4))
SET $PIECE(N40,"^",4,5)=$PIECE(OLD40,"^",4,5)
+26 SET ^MAG(2005,MAGGDA,40)=N40
+27 ;_"$$"_MAGGFDA(2005,"+1,",108))
DO ACTION^MAGGTAU("INDEX-42^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA)
+28 DO ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$PIECE(^MAG(2005,MAGGDA,0),"^",7),1)
+29 QUIT
End DoDot:1
+30 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
+31 ;** IT IS DONE IN A SEPERATE CALL
+32 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on
+33 ;** the workstation
+34 ;
+35 ; Queue it to be copied to Jukebox.
+36 ; CREATE ABSTRACT
+37 ; visn15 ADDED $$DA2PLCA to resolve the Image's current PLACE
+38 IF $GET(MAGGABS)="YES"
SET X=$$ABSTRACT^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"A"))
+39 ; RESTORE AFTER GLOBAL SETUP
+40 IF $GET(MAGGJB)="YES"
SET X=$$JUKEBOX^MAGBAPI(MAGGDA,$$DA2PLC^MAGBAPIP(MAGGDA,"F"))
+41 ; Code for setting a Queue to Copy BIG to JUKEBOX
+42 ;
+43 ; We return the IEN ^ DRIVE:DIR ^ FILE.EXT
+44 ; example: 487^C:\IMAGE\^DC000487.TIF
+45 ; The calling routine is responsible for renaming/naming the file
+46 ; to the returned DRIVE:\DIR\FILENAME.EXT
+47 ; 4/23/98 to include hierarchical directory structure -- PMK
+48 ;
+49 IF 'MAGGR
Begin DoDot:1
+50 SET MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
+51 SET MAGRY=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
+52 ; For now, BIG files are in same directory as FullRes (or PACS) file
+53 IF $GET(MAGBIG)
Begin DoDot:2
+54 SET X=$PIECE(MAGGFNM,".",1)_".BIG"
+55 SET MAGRY=MAGRY_U_MAGGDRV_MAGDHASH_U_X
+56 QUIT
End DoDot:2
+57 QUIT
End DoDot:1
+58 ;
+59 NEW MAGOUT
+60 ; add a new storage work item
DO NWI2005^MAGNWRK1(.MAGOUT,MAGGDA)
+61 ;
CLEAN ;
+1 DO CLEAN^DILF
+2 LOCK -^MAG(2005,NEWIEN)
+3 QUIT
RTRNERR(ETXT) ; There was error from UPDATE^DIE quit with error text
+1 SET ETXT="0^ERROR "_MAGGXE("DIERR",1,"TEXT",1)
+2 QUIT
ERR ; Error trap
+1 SET MAGRY="0^ERROR "_$$EC^%ZOSV
+2 DO @^%ZOSF("ERRTN")
+3 QUIT
MAKENAME() ; MAGGFDA exists so get info from that.
+1 ; We'll make NAME (.01) with PATIENT NAME SSN
+2 ; DOCUMENT Imaging was making name of
+3 ; $E(PATENT NAME,1,10)' '$E(DESC CATEG,1,9)' 'MM/DD/YY (DOC DATE)
+4 NEW Z,ZT,ZNAME,ZSSN,ZDESC
+5 ; GEK 10/10/2000
+6 ; Modifying this procedure to make same name for all Image types
+7 ; The name will be (first 18 chars of patient Name) _ SSN
+8 IF $DATA(MAGGFDA(2005,"+1,",10))
SET ZDESC=$EXTRACT(MAGGFDA(2005,"+1,",10),1,30)
+9 IF $DATA(MAGGFDA(2005,"+1,",5))
Begin DoDot:1
+10 SET X=MAGGFDA(2005,"+1,",5)
+11 SET ZNAME=$PIECE(^DPT(X,0),U)
SET ZSSN=$PIECE(^DPT(X,0),U,9)
End DoDot:1
+12 ;
+13 ; For all Images the name is first 18 characters of patient name
+14 ; concatenated with SSN. If No patient name is sent, well make
+15 ; the name from the short desc.
+16 IF $DATA(ZNAME)
SET Z=$EXTRACT(ZNAME,1,18)_" "_ZSSN
+17 IF '$TEST
SET Z=ZDESC
+18 QUIT Z
