- 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 Feb 18, 2025@23:28:45 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