MAGGA02 ;WOIFO/SG/NST - REMOTE PROCEDURES FOR IMAGE PROPERTIES ; 23 Sep 2010 9:22 AM
;;3.0;IMAGING;**93,117**;Mar 19, 2002;Build 2238;Jul 15, 2011
;; 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
;
;***** GETS THE IMAGE PROPERTIES (FIELDS IN FILE #2005 OR #2005.1)
; RPC: MAGG IMAGE GET PROPERTIES
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; IMGIEN IEN of the image record in the IMAGE file (#2005)
;
; PROPLST Property names separated by semicolons or one of
; the following special characters:
;
; * All supported properties
;
; # Image indexes (IXCLASS, IXORIGIN, IXPKG,
; IXPROC, IXSPEC, and ISTYPE)
;
; See the IPDEFS^MAGGA02A and IPDEFS1^MAGGA02A for
; the lists of supported properties.
;
; [FLAGS] Flags that control the execution (can be combined):
;
; E Return external values (default)
;
; I Return internal values
;
; [ADT] Date/time (internal FileMan value) for retrieving
; previous values. By default ($G(ADT)'>0), audit
; checks are not performed and current values are
; returned.
;
; Return Values
; =============
;
; Zero value of the first '^'-piece of the RESULTS(0) indicates
; that an error occurred during the execution of the procedure.
; In this case, the RESULTS array is formatted as described in the
; comments to the RPCERRS^MAGUERR1 procedure.
;
; Otherwise, '1^Ok' is returned in the RESULTS(0) and subsequent
; nodes contain property values:
;
; RESULTS(0) Result descriptor
; ^01: 1
; ^02: Ok
;
; RESULTS(i) Property value
; ^01: Property name
; ^02: "" (empty)
; ^03: Internal property value if the 'I'
; flag is provided. Otherwise - empty.
; ^04: External property value if the 'E'
; flag is provided. Otherwise - empty.
;
; RESULTS(j) Line of word-processing property value
; ^01: Property name
; ^02: Sequential number
; ^03: Line of text
;
GETPROPS(RESULTS,IMGIEN,PROPLST,FLAGS,ADT) ;RPC [MAGG IMAGE GET PROPERTIES]
N MAGRC,RESCNT
D CLEAR^MAGUERR(1)
K RESULTS S RESULTS(0)="1^Ok",RESCNT=0
S FLAGS=$G(FLAGS),MAGRC=0
;
D
. N FIELD,FLDLST,I,IENS,IMGFILE,MAGBUF,MAGMSG,NAME,PROPDEFS,TMP
. S IMGFILE=2005,PROPDEFS="IPDEFS^MAGGA02A"
. ;=== Check the record IEN
. I '$$ISVALID^MAGGI11(IMGIEN,.MAGRC) D STORE^MAGUERR(MAGRC) Q
. S IENS=IMGIEN_","
. ;~~~ Delete this comment and the following lines of code when
. ;~~~ the IMAGE AUDIT file (#2005.1) is completely eliminated.
. I $$ISDEL^MAGGI11(IMGIEN,.MAGRC) D
. . S IMGFILE=2005.1,PROPDEFS="IPDEFS1^MAGGA02A"
. . Q
. ;
. ;=== Load definitions of the properties
. S MAGRC=$$LDMPDEFS^MAGUTL01(.PROPDEFS,PROPDEFS,"R")
. Q:MAGRC<0
. ;
. ;=== Compile the list of fields
. S FLDLST=""
. I PROPLST="*" D
. . S NAME=""
. . F S NAME=$O(PROPDEFS("N",NAME)) Q:NAME="" D
. . . S TMP=$G(PROPDEFS("N",NAME)),FIELD=$P(TMP,U,2)
. . . Q:($P(TMP,U)'=IMGFILE)!(FIELD'>0)
. . . S FLDLST=FLDLST_";"_FIELD,FLDLST(FIELD)=NAME
. . . Q
. . Q
. E D
. . S:PROPLST="#" PROPLST="IXCLASS;IXORIGIN;IXPKG;IXPROC;IXSPEC;IXTYPE"
. . F I=1:1 S NAME=$P(PROPLST,";",I) Q:NAME="" D
. . . S TMP=$G(PROPDEFS("N",NAME)),FIELD=$P(TMP,U,2)
. . . Q:($P(TMP,U)'=IMGFILE)!(FIELD'>0)
. . . S FLDLST=FLDLST_";"_FIELD,FLDLST(FIELD)=NAME
. . . Q
. . Q
. S FLDLST=$P(FLDLST,";",2,999999) Q:FLDLST=""
. ;
. ;=== Load the field values
. S TMP=$$TRFLAGS^MAGUTL05(FLAGS,"EI")
. S:TMP="" TMP="E",FLAGS=FLAGS_"E"
. D GETS^MAGUTL04(IMGFILE,IENS,FLDLST,TMP,"MAGBUF","MAGMSG",$G(ADT))
. I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",IMGFILE,IENS) Q
. ;
. ;=== Store property values to the result array
. S FIELD=0
. F S FIELD=$O(MAGBUF(IMGFILE,IENS,FIELD)) Q:FIELD'>0 D
. . S NAME=$P(FLDLST(FIELD),U)
. . ;--- Word-processing field
. . I $P(PROPDEFS("N",NAME),U,3)["W" D Q
. . . S I=0
. . . F S I=$O(MAGBUF(IMGFILE,IENS,FIELD,I)) Q:I'>0 D
. . . . S RESCNT=RESCNT+1
. . . . S RESULTS(RESCNT)=NAME_U_I_U_MAGBUF(IMGFILE,IENS,FIELD,I)
. . . . Q
. . . Q
. . ;--- Other types
. . S TMP=NAME
. . S:FLAGS["I" $P(TMP,U,3)=MAGBUF(IMGFILE,IENS,FIELD,"I")
. . S:FLAGS["E" $P(TMP,U,4)=MAGBUF(IMGFILE,IENS,FIELD,"E")
. . S RESCNT=RESCNT+1,RESULTS(RESCNT)=TMP
. . Q
. ;
. ;=== Compute the value of the Image Class property
. I (PROPLST="*")!((";"_PROPLST_";")[";IXCLASS;") D Q:MAGRC<0
. . S TMP=$G(MAGBUF(IMGFILE,IENS,42,"I"))
. . S TMP=$$IXCLASS^MAGGA02A(IMGFILE,IENS,TMP,FLAGS)
. . I TMP<0 S MAGRC=TMP Q
. . S:TMP'=0 RESCNT=RESCNT+1,RESULTS(RESCNT)=TMP
. . Q
. Q
;
;=== Error handling and cleanup
D:MAGRC<0 RPCERRS^MAGUERR1(.RESULTS,MAGRC)
Q
;
;***** SETS THE IMAGE PROPERTIES (FIELDS IN THE FILE #2005)
; RPC: MAGG IMAGE SET PROPERTIES
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; IMGIEN IEN of the image record in the IMAGE file (#2005)
;
; [FLAGS] Reserved for future use
;
; .PROPVALS Reference to a local array that stores new values
; for image properties. See description of the MAGG
; IMAGE SET PROPERTIES remote procedure for details.
;
; See the IPDEFS^MAGGA02A for the list of supported
; properties.
;
; Return Values
; =============
;
; Zero value of the first '^'-piece of the RESULTS(0) indicates
; that an error occurred during the execution of the procedure.
; In this case, the RESULTS array is formatted as described in the
; comments to the RPCERRS^MAGUERR1 procedure.
;
; Otherwise, the RESULTS(0) contains '1^OK'.
;
; Notes
; =====
;
; Properties of images marked as deleted cannot be modified. This
; entry point returns an error (-41) if the IMGIEN parameter
; references a deleted image entry.
;
; If one of the following fields is updated in the parent or the
; child of a group that has only one image, then the changes are
; replicated to the child or parent respectively:
;
; SHORT DESCRIPTION (10), TYPE INDEX (42), PROC/EVENT INDEX (43),
; SPEC/SUBSPEC INDEX (44), ORIGIN INDEX (45), CREATION DATE (110),
; CONTROLLED IMAGE (112), STATUS (113), and STATUS REASON (113.3).
;
SETPROPS(RESULTS,IMGIEN,FLAGS,PROPVALS) ;RPC [MAGG IMAGE SET PROPERTIES]
N MAGNODE,MAGRC
D CLEAR^MAGUERR(1)
K RESULTS S RESULTS(0)="1^Ok"
S MAGRC=0
;
D
. N FLD,IENS,IMGIEN1,NAME,MAGFDA,MAGMSG,MISC,PROPDEFS
. ;=== Set up the error handler
. N $ESTACK,$ETRAP D SETDEFEH^MAGUERR("MAGRC")
. ;
. ;=== Check the record IEN
. I '$$ISVALID^MAGGI11(IMGIEN,.MAGRC) D STORE^MAGUERR(MAGRC) Q
. ;
. ;=== Load definitions of parameters and properties
. S MAGRC=$$LDMPDEFS^MAGUTL01(.PROPDEFS,"IPDEFS^MAGGA02A","W")
. Q:MAGRC<0
. ;
. ;=== Validate the new property values
. S MAGRC=$$RPCMISC^MAGUTL02(.PROPVALS,.MISC,.PROPDEFS,"UV")
. Q:MAGRC<0
. ;
. ;=== Prepare the new data
. S IENS=IMGIEN_","
. S NAME=""
. F S NAME=$O(MISC(NAME)) Q:NAME="" D
. . ;--- Check the file and field numbers and skip parameters
. . ;--- that should not be stored in the IMAGE file (#2005)
. . Q:$P($G(PROPDEFS("N",NAME)),U)'=2005
. . S FLD=$P(PROPDEFS("N",NAME),U,2) Q:FLD'>0
. . ;--- Store the value into the Fileman DBS buffer
. . S MAGFDA(2005,IENS,FLD)=MISC(NAME,"I")
. . Q
. Q:$D(MAGFDA)<10
. ;
. ;=== Check for the group of one and replicate the changes
. S IMGIEN1=$$REPLIC^MAGGA02A(IMGIEN,.MAGFDA)
. I IMGIEN1<0 S MAGRC=IMGIEN1 Q
. ;
. ;=== Patch 117 Check for the STATUS field in the group and set just
. ;=== the first child instead - over protection
. D STATUS1^MAGGA02A(IMGIEN,.MAGFDA)
. I IMGIEN1<0 S MAGRC=IMGIEN1 Q
. ;
. ;=== Lock the image record(s)
. S MAGNODE=$NA(^MAG(2005,IMGIEN))
. S:IMGIEN1>0 MAGNODE="("_MAGNODE_","_$NA(^MAG(2005,IMGIEN1))_")"
. D LOCK^DILF(MAGNODE) E D K MAGNODE Q
. . S MAGRC=$$ERROR^MAGUERR(-21,,"image (IEN="_IMGIEN_")")
. . Q
. ;
. ;=== Check if the image record exists
. I $$ISDEL^MAGGI11(IMGIEN,.MAGRC) D Q
. . S MAGRC=$$ERROR^MAGUERR(-41,,IMGIEN)
. . Q
. I MAGRC<0 D STORE^MAGUERR(MAGRC) Q
. ;
. ;=== Update the image record
. D FILE^DIE(,"MAGFDA","MAGMSG")
. I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",2005,IENS) Q
;
;=== Error handling and cleanup
X:$G(MAGNODE)'="" "L -"_MAGNODE
D:MAGRC<0 RPCERRS^MAGUERR1(.RESULTS,MAGRC)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGA02 9958 printed Oct 16, 2024@18:03:02 Page 2
MAGGA02 ;WOIFO/SG/NST - REMOTE PROCEDURES FOR IMAGE PROPERTIES ; 23 Sep 2010 9:22 AM
+1 ;;3.0;IMAGING;**93,117**;Mar 19, 2002;Build 2238;Jul 15, 2011
+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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
+19 ;***** GETS THE IMAGE PROPERTIES (FIELDS IN FILE #2005 OR #2005.1)
+20 ; RPC: MAGG IMAGE GET PROPERTIES
+21 ;
+22 ; .RESULTS Reference to a local variable where the results
+23 ; are returned to.
+24 ;
+25 ; IMGIEN IEN of the image record in the IMAGE file (#2005)
+26 ;
+27 ; PROPLST Property names separated by semicolons or one of
+28 ; the following special characters:
+29 ;
+30 ; * All supported properties
+31 ;
+32 ; # Image indexes (IXCLASS, IXORIGIN, IXPKG,
+33 ; IXPROC, IXSPEC, and ISTYPE)
+34 ;
+35 ; See the IPDEFS^MAGGA02A and IPDEFS1^MAGGA02A for
+36 ; the lists of supported properties.
+37 ;
+38 ; [FLAGS] Flags that control the execution (can be combined):
+39 ;
+40 ; E Return external values (default)
+41 ;
+42 ; I Return internal values
+43 ;
+44 ; [ADT] Date/time (internal FileMan value) for retrieving
+45 ; previous values. By default ($G(ADT)'>0), audit
+46 ; checks are not performed and current values are
+47 ; returned.
+48 ;
+49 ; Return Values
+50 ; =============
+51 ;
+52 ; Zero value of the first '^'-piece of the RESULTS(0) indicates
+53 ; that an error occurred during the execution of the procedure.
+54 ; In this case, the RESULTS array is formatted as described in the
+55 ; comments to the RPCERRS^MAGUERR1 procedure.
+56 ;
+57 ; Otherwise, '1^Ok' is returned in the RESULTS(0) and subsequent
+58 ; nodes contain property values:
+59 ;
+60 ; RESULTS(0) Result descriptor
+61 ; ^01: 1
+62 ; ^02: Ok
+63 ;
+64 ; RESULTS(i) Property value
+65 ; ^01: Property name
+66 ; ^02: "" (empty)
+67 ; ^03: Internal property value if the 'I'
+68 ; flag is provided. Otherwise - empty.
+69 ; ^04: External property value if the 'E'
+70 ; flag is provided. Otherwise - empty.
+71 ;
+72 ; RESULTS(j) Line of word-processing property value
+73 ; ^01: Property name
+74 ; ^02: Sequential number
+75 ; ^03: Line of text
+76 ;
GETPROPS(RESULTS,IMGIEN,PROPLST,FLAGS,ADT) ;RPC [MAGG IMAGE GET PROPERTIES]
+1 NEW MAGRC,RESCNT
+2 DO CLEAR^MAGUERR(1)
+3 KILL RESULTS
SET RESULTS(0)="1^Ok"
SET RESCNT=0
+4 SET FLAGS=$GET(FLAGS)
SET MAGRC=0
+5 ;
+6 Begin DoDot:1
+7 NEW FIELD,FLDLST,I,IENS,IMGFILE,MAGBUF,MAGMSG,NAME,PROPDEFS,TMP
+8 SET IMGFILE=2005
SET PROPDEFS="IPDEFS^MAGGA02A"
+9 ;=== Check the record IEN
+10 IF '$$ISVALID^MAGGI11(IMGIEN,.MAGRC)
DO STORE^MAGUERR(MAGRC)
QUIT
+11 SET IENS=IMGIEN_","
+12 ;~~~ Delete this comment and the following lines of code when
+13 ;~~~ the IMAGE AUDIT file (#2005.1) is completely eliminated.
+14 IF $$ISDEL^MAGGI11(IMGIEN,.MAGRC)
Begin DoDot:2
+15 SET IMGFILE=2005.1
SET PROPDEFS="IPDEFS1^MAGGA02A"
+16 QUIT
End DoDot:2
+17 ;
+18 ;=== Load definitions of the properties
+19 SET MAGRC=$$LDMPDEFS^MAGUTL01(.PROPDEFS,PROPDEFS,"R")
+20 if MAGRC<0
QUIT
+21 ;
+22 ;=== Compile the list of fields
+23 SET FLDLST=""
+24 IF PROPLST="*"
Begin DoDot:2
+25 SET NAME=""
+26 FOR
SET NAME=$ORDER(PROPDEFS("N",NAME))
if NAME=""
QUIT
Begin DoDot:3
+27 SET TMP=$GET(PROPDEFS("N",NAME))
SET FIELD=$PIECE(TMP,U,2)
+28 if ($PIECE(TMP,U)'=IMGFILE)!(FIELD'>0)
QUIT
+29 SET FLDLST=FLDLST_";"_FIELD
SET FLDLST(FIELD)=NAME
+30 QUIT
End DoDot:3
+31 QUIT
End DoDot:2
+32 IF '$TEST
Begin DoDot:2
+33 if PROPLST="#"
SET PROPLST="IXCLASS;IXORIGIN;IXPKG;IXPROC;IXSPEC;IXTYPE"
+34 FOR I=1:1
SET NAME=$PIECE(PROPLST,";",I)
if NAME=""
QUIT
Begin DoDot:3
+35 SET TMP=$GET(PROPDEFS("N",NAME))
SET FIELD=$PIECE(TMP,U,2)
+36 if ($PIECE(TMP,U)'=IMGFILE)!(FIELD'>0)
QUIT
+37 SET FLDLST=FLDLST_";"_FIELD
SET FLDLST(FIELD)=NAME
+38 QUIT
End DoDot:3
+39 QUIT
End DoDot:2
+40 SET FLDLST=$PIECE(FLDLST,";",2,999999)
if FLDLST=""
QUIT
+41 ;
+42 ;=== Load the field values
+43 SET TMP=$$TRFLAGS^MAGUTL05(FLAGS,"EI")
+44 if TMP=""
SET TMP="E"
SET FLAGS=FLAGS_"E"
+45 DO GETS^MAGUTL04(IMGFILE,IENS,FLDLST,TMP,"MAGBUF","MAGMSG",$GET(ADT))
+46 IF $GET(DIERR)
SET MAGRC=$$DBS^MAGUERR("MAGMSG",IMGFILE,IENS)
QUIT
+47 ;
+48 ;=== Store property values to the result array
+49 SET FIELD=0
+50 FOR
SET FIELD=$ORDER(MAGBUF(IMGFILE,IENS,FIELD))
if FIELD'>0
QUIT
Begin DoDot:2
+51 SET NAME=$PIECE(FLDLST(FIELD),U)
+52 ;--- Word-processing field
+53 IF $PIECE(PROPDEFS("N",NAME),U,3)["W"
Begin DoDot:3
+54 SET I=0
+55 FOR
SET I=$ORDER(MAGBUF(IMGFILE,IENS,FIELD,I))
if I'>0
QUIT
Begin DoDot:4
+56 SET RESCNT=RESCNT+1
+57 SET RESULTS(RESCNT)=NAME_U_I_U_MAGBUF(IMGFILE,IENS,FIELD,I)
+58 QUIT
End DoDot:4
+59 QUIT
End DoDot:3
QUIT
+60 ;--- Other types
+61 SET TMP=NAME
+62 if FLAGS["I"
SET $PIECE(TMP,U,3)=MAGBUF(IMGFILE,IENS,FIELD,"I")
+63 if FLAGS["E"
SET $PIECE(TMP,U,4)=MAGBUF(IMGFILE,IENS,FIELD,"E")
+64 SET RESCNT=RESCNT+1
SET RESULTS(RESCNT)=TMP
+65 QUIT
End DoDot:2
+66 ;
+67 ;=== Compute the value of the Image Class property
+68 IF (PROPLST="*")!((";"_PROPLST_";")[";IXCLASS;")
Begin DoDot:2
+69 SET TMP=$GET(MAGBUF(IMGFILE,IENS,42,"I"))
+70 SET TMP=$$IXCLASS^MAGGA02A(IMGFILE,IENS,TMP,FLAGS)
+71 IF TMP<0
SET MAGRC=TMP
QUIT
+72 if TMP'=0
SET RESCNT=RESCNT+1
SET RESULTS(RESCNT)=TMP
+73 QUIT
End DoDot:2
if MAGRC<0
QUIT
+74 QUIT
End DoDot:1
+75 ;
+76 ;=== Error handling and cleanup
+77 if MAGRC<0
DO RPCERRS^MAGUERR1(.RESULTS,MAGRC)
+78 QUIT
+79 ;
+80 ;***** SETS THE IMAGE PROPERTIES (FIELDS IN THE FILE #2005)
+81 ; RPC: MAGG IMAGE SET PROPERTIES
+82 ;
+83 ; .RESULTS Reference to a local variable where the results
+84 ; are returned to.
+85 ;
+86 ; IMGIEN IEN of the image record in the IMAGE file (#2005)
+87 ;
+88 ; [FLAGS] Reserved for future use
+89 ;
+90 ; .PROPVALS Reference to a local array that stores new values
+91 ; for image properties. See description of the MAGG
+92 ; IMAGE SET PROPERTIES remote procedure for details.
+93 ;
+94 ; See the IPDEFS^MAGGA02A for the list of supported
+95 ; properties.
+96 ;
+97 ; Return Values
+98 ; =============
+99 ;
+100 ; Zero value of the first '^'-piece of the RESULTS(0) indicates
+101 ; that an error occurred during the execution of the procedure.
+102 ; In this case, the RESULTS array is formatted as described in the
+103 ; comments to the RPCERRS^MAGUERR1 procedure.
+104 ;
+105 ; Otherwise, the RESULTS(0) contains '1^OK'.
+106 ;
+107 ; Notes
+108 ; =====
+109 ;
+110 ; Properties of images marked as deleted cannot be modified. This
+111 ; entry point returns an error (-41) if the IMGIEN parameter
+112 ; references a deleted image entry.
+113 ;
+114 ; If one of the following fields is updated in the parent or the
+115 ; child of a group that has only one image, then the changes are
+116 ; replicated to the child or parent respectively:
+117 ;
+118 ; SHORT DESCRIPTION (10), TYPE INDEX (42), PROC/EVENT INDEX (43),
+119 ; SPEC/SUBSPEC INDEX (44), ORIGIN INDEX (45), CREATION DATE (110),
+120 ; CONTROLLED IMAGE (112), STATUS (113), and STATUS REASON (113.3).
+121 ;
SETPROPS(RESULTS,IMGIEN,FLAGS,PROPVALS) ;RPC [MAGG IMAGE SET PROPERTIES]
+1 NEW MAGNODE,MAGRC
+2 DO CLEAR^MAGUERR(1)
+3 KILL RESULTS
SET RESULTS(0)="1^Ok"
+4 SET MAGRC=0
+5 ;
+6 Begin DoDot:1
+7 NEW FLD,IENS,IMGIEN1,NAME,MAGFDA,MAGMSG,MISC,PROPDEFS
+8 ;=== Set up the error handler
+9 NEW $ESTACK,$ETRAP
DO SETDEFEH^MAGUERR("MAGRC")
+10 ;
+11 ;=== Check the record IEN
+12 IF '$$ISVALID^MAGGI11(IMGIEN,.MAGRC)
DO STORE^MAGUERR(MAGRC)
QUIT
+13 ;
+14 ;=== Load definitions of parameters and properties
+15 SET MAGRC=$$LDMPDEFS^MAGUTL01(.PROPDEFS,"IPDEFS^MAGGA02A","W")
+16 if MAGRC<0
QUIT
+17 ;
+18 ;=== Validate the new property values
+19 SET MAGRC=$$RPCMISC^MAGUTL02(.PROPVALS,.MISC,.PROPDEFS,"UV")
+20 if MAGRC<0
QUIT
+21 ;
+22 ;=== Prepare the new data
+23 SET IENS=IMGIEN_","
+24 SET NAME=""
+25 FOR
SET NAME=$ORDER(MISC(NAME))
if NAME=""
QUIT
Begin DoDot:2
+26 ;--- Check the file and field numbers and skip parameters
+27 ;--- that should not be stored in the IMAGE file (#2005)
+28 if $PIECE($GET(PROPDEFS("N",NAME)),U)'=2005
QUIT
+29 SET FLD=$PIECE(PROPDEFS("N",NAME),U,2)
if FLD'>0
QUIT
+30 ;--- Store the value into the Fileman DBS buffer
+31 SET MAGFDA(2005,IENS,FLD)=MISC(NAME,"I")
+32 QUIT
End DoDot:2
+33 if $DATA(MAGFDA)<10
QUIT
+34 ;
+35 ;=== Check for the group of one and replicate the changes
+36 SET IMGIEN1=$$REPLIC^MAGGA02A(IMGIEN,.MAGFDA)
+37 IF IMGIEN1<0
SET MAGRC=IMGIEN1
QUIT
+38 ;
+39 ;=== Patch 117 Check for the STATUS field in the group and set just
+40 ;=== the first child instead - over protection
+41 DO STATUS1^MAGGA02A(IMGIEN,.MAGFDA)
+42 IF IMGIEN1<0
SET MAGRC=IMGIEN1
QUIT
+43 ;
+44 ;=== Lock the image record(s)
+45 SET MAGNODE=$NAME(^MAG(2005,IMGIEN))
+46 if IMGIEN1>0
SET MAGNODE="("_MAGNODE_","_$NAME(^MAG(2005,IMGIEN1))_")"
+47 DO LOCK^DILF(MAGNODE)
IF '$TEST
Begin DoDot:2
+48 SET MAGRC=$$ERROR^MAGUERR(-21,,"image (IEN="_IMGIEN_")")
+49 QUIT
End DoDot:2
KILL MAGNODE
QUIT
+50 ;
+51 ;=== Check if the image record exists
+52 IF $$ISDEL^MAGGI11(IMGIEN,.MAGRC)
Begin DoDot:2
+53 SET MAGRC=$$ERROR^MAGUERR(-41,,IMGIEN)
+54 QUIT
End DoDot:2
QUIT
+55 IF MAGRC<0
DO STORE^MAGUERR(MAGRC)
QUIT
+56 ;
+57 ;=== Update the image record
+58 DO FILE^DIE(,"MAGFDA","MAGMSG")
+59 IF $GET(DIERR)
SET MAGRC=$$DBS^MAGUERR("MAGMSG",2005,IENS)
QUIT
End DoDot:1
+60 ;
+61 ;=== Error handling and cleanup
+62 if $GET(MAGNODE)'=""
XECUTE "L -"_MAGNODE
+63 if MAGRC<0
DO RPCERRS^MAGUERR1(.RESULTS,MAGRC)
+64 QUIT
