MAGGSIA ;WOIFO/GEK/SG/NST - Imaging RPC Broker calls. Add/Modify Image entry ; Dec 05, 2018@10:43am
;;3.0;IMAGING;**7,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
;
;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE
;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL.
;
ADD(MAGRY,MAGARRAY) ; RPC [MAG4 ADD IMAGE]
; Calls UPDATE^DIE to Add an Image File entry
; Called from Import API Delphi component and ImportX (Active X) control.
; Parameters :
; MAGARRAY - array of field numbers and their entries
; i.e. MAGARRAY(1)=".5^38" field# .5 data is 38
; If Long Description is included in array (field 11), we create a new
; array to hold the text, and pass that to UPDATE^DIE
; If this entry is an Image Group
; i.e. MAGARRAY(n)="2005.04^344"
; (the field 2005.04 is the OBJECT GROUP MULTIPLE)
; ( 344 is the pointer to the Image File Entry that will be added
; ( as a member of this new/existing Group)
;
; Return Variable
;
; MAGRY(0) - Array
; Successful MAGRY(0) = IEN^FILE NAME (with full path)
; UNsuccessful MAGRY(0) = 0^Error desc
; MAGRY(0)(1..n) = Errors and warnings.
;
; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK
; TO THE NEW FILE NAME RETURNED BY THIS CALL.
; Changed to include hierarchical directory hash - PMK 04/23/98
;----------------------------------------------------------------
N MAGGFDA,MAGGDRV,MAGGRP,MAGCHLD,GRPCT,MAGGDA,MAGGFNM
N MAGGWP,MAGERR,MAGREF,MAGDHASH,MAGTEMP,MAGACT,MAGGIEN,MAGGXE
N NEWIEN,I,J,X,Y,Z,WPCT
;
N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGSERR"
I ($D(MAGARRAY)<10) S MAGRY(0)="0^No input data, Operation CANCELED" Q
;
S MAGRY(0)="0^Creating VistA Image Entry..."
S MAGERR="",MAGGRP=0,GRPCT=1,WPCT=0
; Validate the Data, and Action codes in the Input Array
D VAL^MAGGSIV(.MAGRY,.MAGARRAY) I 'MAGRY(0) Q
;
; Make the FileMan FDA array and the Imaging Action array.
D MAKEFDA^MAGGSIU2(.MAGGFDA,.MAGARRAY,.MAGACT,.MAGCHLD,.MAGGRP,.MAGGWP)
I '$D(MAGGFDA(2005,"+1,")) S MAGRY(0)="0^No data to file. Operation CANCELED." Q
;
;Q:'$$VALINDEX^MAGGSIV1(.MAGRY,$G(MAGGFDA(2005,"+1,",42)),$G(MAGGFDA(2005,"+1,",44)),$G(MAGGFDA(2005,"+1,",43)))
; Check on some possible problems: required fields, create default values etc.
D PRE^MAGGSIA1(.MAGERR,.MAGGFDA,MAGGRP,.MAGGDRV,.MAGREF) I $L(MAGERR) S MAGRY(0)=MAGERR Q
; Locking Patch 8. Get latest Image IEN and Deleted IEN take the greater of the two.
S (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12() ; SG - MAG*3*93
D UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
;
; ERROR: QUIT
I '$G(MAGGIEN(1)) D S MAGRY(0)=MAGERR Q
. S MAGERR="0^ERROR Creating new Image File Entry "
. I $D(DIERR) D RTRNERR^MAGGSIU1(.MAGERR)
. D CLEAN
;
S MAGGDA=MAGGIEN(1)
;
D ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
;
; IF a group, UpDate the GROUP PARENT in each Group Object and QUIT
; The Return (MAGRY(0)) will be IEN with NO Filename. Groups don't get Filename
I MAGGRP D G C1
. D UPDCHLD^MAGGSIM(.MAGCHLD,MAGGDA)
. S MAGRY(0)=MAGGDA_U
. D CLEAN
. Q
; ENTRY in Image File has been made, if any errors from here on
; then we have to delete the image entry.
; IF This image is a member of a Group, Update the Group Entry with new child.
S X=$G(MAGGFDA(2005,"+1,",14)) I +X D I $L(MAGERR) Q
. D UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA)
. I $L(MAGERR) S MAGRY(0)=MAGERR D CLEAN
;
; Now generate the Image FileName. This is passed back to the calling app,
; and the calling app is responsible for renaming/copying the Image File to
; this new name.
I $D(MAGGFDA(2005,"+1,",1)) S MAGGFNM=MAGGFDA(2005,"+1,",1)
E D I $L(MAGERR) S MAGRY(0)=MAGERR Q
. N MAGXFDA
. S X=$$DA2NAME^MAGGTU1(MAGGDA,$G(MAGACT("EXT"))) I 'X D Q
. . S MAGERR=X
. . D KILLENT^MAGGSIU1(MAGGDA)
. . D CLEAN
. ;
. S MAGGFNM=$P(X,U,2),Y=MAGGDA_","
. S MAGXFDA(2005,Y,1)=MAGGFNM
. D UPDATE^DIE("","MAGXFDA","","MAGGXE")
. ; in case of an error
. I $D(DIERR) D Q
. . D RTRNERR^MAGGSIU1(.MAGERR,.MAGGXE)
. . D KILLENT^MAGGSIU1(MAGGDA)
. . D CLEAN
;
C1 ; 59
K MAGGFDA ; P59.
;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)
. D COMIEN^MAGXCVC(MAGGDA,.INDXD)
. S ^MAGIXCVT(2006.96,MAGGDA)=1 ; Flag. Says fields were converted by index generation
. ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
. ;;D ACTION^MAGGTAU("GENINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA_"$$"_MAGGFDA(2005,"+1,",108))
. D ACTION^MAGGTAU("INDEX-ALL^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5))
. 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,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 ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$P(^MAG(2005,MAGGDA,100),"^",5))
. 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.
;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on the workstation
;
; The Return is: IEN ^ DRIVE:DIR ^ FILE.EXT [^ DRIVE:DIR ^ FILE.BIG]
; example: 487^C:\IMAGE\^DC000487.TIF
; The calling routine is responsible for renaming/naming the file
; to the returned DRIVE:\DIR\FILENAME.EXT
;
; Modified 4/23/98 to include hierarchical directory structure -- PMK
I 'MAGGRP D
. S MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
. ; For now, BIG files are in same directory as FullRes (or PACS) file
. S MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
. ; If BIG file also, add it's Drive, Hash, Filename to end of Return string.
. I $G(MAGACT("BIG")) D
. . S X=$P(MAGGFNM,".",1)_".BIG"
. . S MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X
. . Q
. Q
;
N MAGOUT
D NWI2005^MAGNWRK1(.MAGOUT,MAGGDA) ; add a new storage work item
;
CLEAN ; Called as tag
D CLEAN^DILF
L -^MAG(2005,NEWIEN)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGSIA 7893 printed Sep 23, 2025@19:38:53 Page 2
MAGGSIA ;WOIFO/GEK/SG/NST - Imaging RPC Broker calls. Add/Modify Image entry ; Dec 05, 2018@10:43am
+1 ;;3.0;IMAGING;**7,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
+19 ;
+20 ;**** CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE
+21 ;**** on DISK TO THE NEW FILE NAME RETURNED BY THIS CALL.
+22 ;
ADD(MAGRY,MAGARRAY) ; RPC [MAG4 ADD IMAGE]
+1 ; Calls UPDATE^DIE to Add an Image File entry
+2 ; Called from Import API Delphi component and ImportX (Active X) control.
+3 ; Parameters :
+4 ; MAGARRAY - array of field numbers and their entries
+5 ; i.e. MAGARRAY(1)=".5^38" field# .5 data is 38
+6 ; If Long Description is included in array (field 11), we create a new
+7 ; array to hold the text, and pass that to UPDATE^DIE
+8 ; If this entry is an Image Group
+9 ; i.e. MAGARRAY(n)="2005.04^344"
+10 ; (the field 2005.04 is the OBJECT GROUP MULTIPLE)
+11 ; ( 344 is the pointer to the Image File Entry that will be added
+12 ; ( as a member of this new/existing Group)
+13 ;
+14 ; Return Variable
+15 ;
+16 ; MAGRY(0) - Array
+17 ; Successful MAGRY(0) = IEN^FILE NAME (with full path)
+18 ; UNsuccessful MAGRY(0) = 0^Error desc
+19 ; MAGRY(0)(1..n) = Errors and warnings.
+20 ;
+21 ; CALLING ROUTINE is responsible for RENAMING THE IMAGE FILE on DISK
+22 ; TO THE NEW FILE NAME RETURNED BY THIS CALL.
+23 ; Changed to include hierarchical directory hash - PMK 04/23/98
+24 ;----------------------------------------------------------------
+25 NEW MAGGFDA,MAGGDRV,MAGGRP,MAGCHLD,GRPCT,MAGGDA,MAGGFNM
+26 NEW MAGGWP,MAGERR,MAGREF,MAGDHASH,MAGTEMP,MAGACT,MAGGIEN,MAGGXE
+27 NEW NEWIEN,I,J,X,Y,Z,WPCT
+28 ;
+29 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERRA^MAGGSERR"
+30 IF ($DATA(MAGARRAY)<10)
SET MAGRY(0)="0^No input data, Operation CANCELED"
QUIT
+31 ;
+32 SET MAGRY(0)="0^Creating VistA Image Entry..."
+33 SET MAGERR=""
SET MAGGRP=0
SET GRPCT=1
SET WPCT=0
+34 ; Validate the Data, and Action codes in the Input Array
+35 DO VAL^MAGGSIV(.MAGRY,.MAGARRAY)
IF 'MAGRY(0)
QUIT
+36 ;
+37 ; Make the FileMan FDA array and the Imaging Action array.
+38 DO MAKEFDA^MAGGSIU2(.MAGGFDA,.MAGARRAY,.MAGACT,.MAGCHLD,.MAGGRP,.MAGGWP)
+39 IF '$DATA(MAGGFDA(2005,"+1,"))
SET MAGRY(0)="0^No data to file. Operation CANCELED."
QUIT
+40 ;
+41 ;Q:'$$VALINDEX^MAGGSIV1(.MAGRY,$G(MAGGFDA(2005,"+1,",42)),$G(MAGGFDA(2005,"+1,",44)),$G(MAGGFDA(2005,"+1,",43)))
+42 ; Check on some possible problems: required fields, create default values etc.
+43 DO PRE^MAGGSIA1(.MAGERR,.MAGGFDA,MAGGRP,.MAGGDRV,.MAGREF)
IF $LENGTH(MAGERR)
SET MAGRY(0)=MAGERR
QUIT
+44 ; Locking Patch 8. Get latest Image IEN and Deleted IEN take the greater of the two.
+45 ; SG - MAG*3*93
SET (MAGGIEN(1),NEWIEN)=$$NEWIEN^MAGGI12()
+46 DO UPDATE^DIE("S","MAGGFDA","MAGGIEN","MAGGXE")
+47 ;
+48 ; ERROR: QUIT
+49 IF '$GET(MAGGIEN(1))
Begin DoDot:1
+50 SET MAGERR="0^ERROR Creating new Image File Entry "
+51 IF $DATA(DIERR)
DO RTRNERR^MAGGSIU1(.MAGERR)
+52 DO CLEAN
End DoDot:1
SET MAGRY(0)=MAGERR
QUIT
+53 ;
+54 SET MAGGDA=MAGGIEN(1)
+55 ;
+56 DO ACTION^MAGGTAU("CAP^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA)
+57 ;
+58 ; IF a group, UpDate the GROUP PARENT in each Group Object and QUIT
+59 ; The Return (MAGRY(0)) will be IEN with NO Filename. Groups don't get Filename
+60 IF MAGGRP
Begin DoDot:1
+61 DO UPDCHLD^MAGGSIM(.MAGCHLD,MAGGDA)
+62 SET MAGRY(0)=MAGGDA_U
+63 DO CLEAN
+64 QUIT
End DoDot:1
GOTO C1
+65 ; ENTRY in Image File has been made, if any errors from here on
+66 ; then we have to delete the image entry.
+67 ; IF This image is a member of a Group, Update the Group Entry with new child.
+68 SET X=$GET(MAGGFDA(2005,"+1,",14))
IF +X
Begin DoDot:1
+69 DO UPDPAR^MAGGSIM(.MAGERR,X,.MAGACT,MAGGDA)
+70 IF $LENGTH(MAGERR)
SET MAGRY(0)=MAGERR
DO CLEAN
End DoDot:1
IF $LENGTH(MAGERR)
QUIT
+71 ;
+72 ; Now generate the Image FileName. This is passed back to the calling app,
+73 ; and the calling app is responsible for renaming/copying the Image File to
+74 ; this new name.
+75 IF $DATA(MAGGFDA(2005,"+1,",1))
SET MAGGFNM=MAGGFDA(2005,"+1,",1)
+76 IF '$TEST
Begin DoDot:1
+77 NEW MAGXFDA
+78 SET X=$$DA2NAME^MAGGTU1(MAGGDA,$GET(MAGACT("EXT")))
IF 'X
Begin DoDot:2
+79 SET MAGERR=X
+80 DO KILLENT^MAGGSIU1(MAGGDA)
+81 DO CLEAN
End DoDot:2
QUIT
+82 ;
+83 SET MAGGFNM=$PIECE(X,U,2)
SET Y=MAGGDA_","
+84 SET MAGXFDA(2005,Y,1)=MAGGFNM
+85 DO UPDATE^DIE("","MAGXFDA","","MAGGXE")
+86 ; in case of an error
+87 IF $DATA(DIERR)
Begin DoDot:2
+88 DO RTRNERR^MAGGSIU1(.MAGERR,.MAGGXE)
+89 DO KILLENT^MAGGSIU1(MAGGDA)
+90 DO CLEAN
End DoDot:2
QUIT
End DoDot:1
IF $LENGTH(MAGERR)
SET MAGRY(0)=MAGERR
QUIT
+91 ;
C1 ; 59
+1 ; P59.
KILL MAGGFDA
+2 ;P59 Now we Auto-Generate the Index Fields, if they don't exist for this entry
+3 IF '$DATA(^MAG(2005,MAGGDA,40))
Begin DoDot:1
+4 NEW INDXD
+5 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
+6 DO COMIEN^MAGXCVC(MAGGDA,.INDXD)
+7 ; Flag. Says fields were converted by index generation
SET ^MAGIXCVT(2006.96,MAGGDA)=1
+8 ; TRKING ID TRKID = MAGGFDA(2005,"+1,",108)
+9 ;;D ACTION^MAGGTAU("GENINDX^"_MAGGFDA(2005,"+1,",5)_"^"_MAGGDA_"$$"_MAGGFDA(2005,"+1,",108))
+10 DO ACTION^MAGGTAU("INDEX-ALL^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$PIECE(^MAG(2005,MAGGDA,100),"^",5))
+11 QUIT
End DoDot:1
+12 ;
+13 ;P59 If TYPE INDEX is missing we Auto-Generate Index Type and other missing Index Term values.
+14 IF '$PIECE(^MAG(2005,MAGGDA,40),"^",3)
Begin DoDot:1
+15 NEW INDXD,OLD40,N40
+16 SET (N40,OLD40)=^MAG(2005,MAGGDA,40)
+17 DO GENIEN^MAGXCVI(MAGGDA,.INDXD)
+18 ; If Origin doesn't exist in existing, this will put V in.
+19 IF $PIECE(INDXD,"^",6)=""
SET $PIECE(INDXD,"^",6)="V"
+20 ; We're not changing existing values of Spec,Proc or Origin
+21 FOR J=1:1:6
IF '$LENGTH($PIECE(N40,"^",J))
SET $PIECE(N40,"^",J)=$PIECE(INDXD,"^",J)
+22 ;Validate the merged Spec and Proc, if not valid, revert back to old Spec and Proc
+23 IF '$$VALINDEX^MAGGSIV1(.X,$PIECE(N40,"^",3),$PIECE(N40,"^",5),$PIECE(N40,"^",4))
SET $PIECE(N40,"^",4,5)=$PIECE(OLD40,"^",4,5)
+24 SET ^MAG(2005,MAGGDA,40)=N40
+25 ;;D ACTION^MAGGTAU("INDEX-42^"_$P(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA) ;_"$$"_MAGGFDA(2005,"+1,",108))
+26 DO ACTION^MAGGTAU("INDEX-42^"_$PIECE(^MAG(2005,MAGGDA,0),"^",7)_"^"_MAGGDA_"$$"_$PIECE(^MAG(2005,MAGGDA,100),"^",5))
+27 DO ENTRY^MAGLOG("INDEX-42",DUZ,MAGGDA,"P59",$PIECE(^MAG(2005,MAGGDA,0),"^",7),1)
+28 QUIT
End DoDot:1
+29 ;** ABS and JB image queues AREN'T SET WHEN ADDING AN IMAGE.
+30 ;** RPC =-> 'MAG ABSJB' after abstract is/isn't created on the workstation
+31 ;
+32 ; The Return is: IEN ^ DRIVE:DIR ^ FILE.EXT [^ DRIVE:DIR ^ FILE.BIG]
+33 ; example: 487^C:\IMAGE\^DC000487.TIF
+34 ; The calling routine is responsible for renaming/naming the file
+35 ; to the returned DRIVE:\DIR\FILENAME.EXT
+36 ;
+37 ; Modified 4/23/98 to include hierarchical directory structure -- PMK
+38 IF 'MAGGRP
Begin DoDot:1
+39 SET MAGDHASH=$$DIRHASH^MAGFILEB(MAGGFNM,MAGREF)
+40 ; For now, BIG files are in same directory as FullRes (or PACS) file
+41 SET MAGRY(0)=MAGGDA_U_MAGGDRV_MAGDHASH_U_MAGGFNM
+42 ; If BIG file also, add it's Drive, Hash, Filename to end of Return string.
+43 IF $GET(MAGACT("BIG"))
Begin DoDot:2
+44 SET X=$PIECE(MAGGFNM,".",1)_".BIG"
+45 SET MAGRY(0)=MAGRY(0)_U_MAGGDRV_MAGDHASH_U_X
+46 QUIT
End DoDot:2
+47 QUIT
End DoDot:1
+48 ;
+49 NEW MAGOUT
+50 ; add a new storage work item
DO NWI2005^MAGNWRK1(.MAGOUT,MAGGDA)
+51 ;
CLEAN ; Called as tag
+1 DO CLEAN^DILF
+2 LOCK -^MAG(2005,NEWIEN)
+3 QUIT
