Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGGA02

MAGGA02.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. Q
  1. ;
  1. ;***** GETS THE IMAGE PROPERTIES (FIELDS IN FILE #2005 OR #2005.1)
  1. ; RPC: MAGG IMAGE GET PROPERTIES
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; IMGIEN IEN of the image record in the IMAGE file (#2005)
  1. ;
  1. ; PROPLST Property names separated by semicolons or one of
  1. ; the following special characters:
  1. ;
  1. ; * All supported properties
  1. ;
  1. ; # Image indexes (IXCLASS, IXORIGIN, IXPKG,
  1. ; IXPROC, IXSPEC, and ISTYPE)
  1. ;
  1. ; See the IPDEFS^MAGGA02A and IPDEFS1^MAGGA02A for
  1. ; the lists of supported properties.
  1. ;
  1. ; [FLAGS] Flags that control the execution (can be combined):
  1. ;
  1. ; E Return external values (default)
  1. ;
  1. ; I Return internal values
  1. ;
  1. ; [ADT] Date/time (internal FileMan value) for retrieving
  1. ; previous values. By default ($G(ADT)'>0), audit
  1. ; checks are not performed and current values are
  1. ; returned.
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; Zero value of the first '^'-piece of the RESULTS(0) indicates
  1. ; that an error occurred during the execution of the procedure.
  1. ; In this case, the RESULTS array is formatted as described in the
  1. ; comments to the RPCERRS^MAGUERR1 procedure.
  1. ;
  1. ; Otherwise, '1^Ok' is returned in the RESULTS(0) and subsequent
  1. ; nodes contain property values:
  1. ;
  1. ; RESULTS(0) Result descriptor
  1. ; ^01: 1
  1. ; ^02: Ok
  1. ;
  1. ; RESULTS(i) Property value
  1. ; ^01: Property name
  1. ; ^02: "" (empty)
  1. ; ^03: Internal property value if the 'I'
  1. ; flag is provided. Otherwise - empty.
  1. ; ^04: External property value if the 'E'
  1. ; flag is provided. Otherwise - empty.
  1. ;
  1. ; RESULTS(j) Line of word-processing property value
  1. ; ^01: Property name
  1. ; ^02: Sequential number
  1. ; ^03: Line of text
  1. ;
  1. GETPROPS(RESULTS,IMGIEN,PROPLST,FLAGS,ADT) ;RPC [MAGG IMAGE GET PROPERTIES]
  1. N MAGRC,RESCNT
  1. D CLEAR^MAGUERR(1)
  1. K RESULTS S RESULTS(0)="1^Ok",RESCNT=0
  1. S FLAGS=$G(FLAGS),MAGRC=0
  1. ;
  1. D
  1. . N FIELD,FLDLST,I,IENS,IMGFILE,MAGBUF,MAGMSG,NAME,PROPDEFS,TMP
  1. . S IMGFILE=2005,PROPDEFS="IPDEFS^MAGGA02A"
  1. . ;=== Check the record IEN
  1. . I '$$ISVALID^MAGGI11(IMGIEN,.MAGRC) D STORE^MAGUERR(MAGRC) Q
  1. . S IENS=IMGIEN_","
  1. . ;~~~ Delete this comment and the following lines of code when
  1. . ;~~~ the IMAGE AUDIT file (#2005.1) is completely eliminated.
  1. . I $$ISDEL^MAGGI11(IMGIEN,.MAGRC) D
  1. . . S IMGFILE=2005.1,PROPDEFS="IPDEFS1^MAGGA02A"
  1. . . Q
  1. . ;
  1. . ;=== Load definitions of the properties
  1. . S MAGRC=$$LDMPDEFS^MAGUTL01(.PROPDEFS,PROPDEFS,"R")
  1. . Q:MAGRC<0
  1. . ;
  1. . ;=== Compile the list of fields
  1. . S FLDLST=""
  1. . I PROPLST="*" D
  1. . . S NAME=""
  1. . . F S NAME=$O(PROPDEFS("N",NAME)) Q:NAME="" D
  1. . . . S TMP=$G(PROPDEFS("N",NAME)),FIELD=$P(TMP,U,2)
  1. . . . Q:($P(TMP,U)'=IMGFILE)!(FIELD'>0)
  1. . . . S FLDLST=FLDLST_";"_FIELD,FLDLST(FIELD)=NAME
  1. . . . Q
  1. . . Q
  1. . E D
  1. . . S:PROPLST="#" PROPLST="IXCLASS;IXORIGIN;IXPKG;IXPROC;IXSPEC;IXTYPE"
  1. . . F I=1:1 S NAME=$P(PROPLST,";",I) Q:NAME="" D
  1. . . . S TMP=$G(PROPDEFS("N",NAME)),FIELD=$P(TMP,U,2)
  1. . . . Q:($P(TMP,U)'=IMGFILE)!(FIELD'>0)
  1. . . . S FLDLST=FLDLST_";"_FIELD,FLDLST(FIELD)=NAME
  1. . . . Q
  1. . . Q
  1. . S FLDLST=$P(FLDLST,";",2,999999) Q:FLDLST=""
  1. . ;
  1. . ;=== Load the field values
  1. . S TMP=$$TRFLAGS^MAGUTL05(FLAGS,"EI")
  1. . S:TMP="" TMP="E",FLAGS=FLAGS_"E"
  1. . D GETS^MAGUTL04(IMGFILE,IENS,FLDLST,TMP,"MAGBUF","MAGMSG",$G(ADT))
  1. . I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",IMGFILE,IENS) Q
  1. . ;
  1. . ;=== Store property values to the result array
  1. . S FIELD=0
  1. . F S FIELD=$O(MAGBUF(IMGFILE,IENS,FIELD)) Q:FIELD'>0 D
  1. . . S NAME=$P(FLDLST(FIELD),U)
  1. . . ;--- Word-processing field
  1. . . I $P(PROPDEFS("N",NAME),U,3)["W" D Q
  1. . . . S I=0
  1. . . . F S I=$O(MAGBUF(IMGFILE,IENS,FIELD,I)) Q:I'>0 D
  1. . . . . S RESCNT=RESCNT+1
  1. . . . . S RESULTS(RESCNT)=NAME_U_I_U_MAGBUF(IMGFILE,IENS,FIELD,I)
  1. . . . . Q
  1. . . . Q
  1. . . ;--- Other types
  1. . . S TMP=NAME
  1. . . S:FLAGS["I" $P(TMP,U,3)=MAGBUF(IMGFILE,IENS,FIELD,"I")
  1. . . S:FLAGS["E" $P(TMP,U,4)=MAGBUF(IMGFILE,IENS,FIELD,"E")
  1. . . S RESCNT=RESCNT+1,RESULTS(RESCNT)=TMP
  1. . . Q
  1. . ;
  1. . ;=== Compute the value of the Image Class property
  1. . I (PROPLST="*")!((";"_PROPLST_";")[";IXCLASS;") D Q:MAGRC<0
  1. . . S TMP=$G(MAGBUF(IMGFILE,IENS,42,"I"))
  1. . . S TMP=$$IXCLASS^MAGGA02A(IMGFILE,IENS,TMP,FLAGS)
  1. . . I TMP<0 S MAGRC=TMP Q
  1. . . S:TMP'=0 RESCNT=RESCNT+1,RESULTS(RESCNT)=TMP
  1. . . Q
  1. . Q
  1. ;
  1. ;=== Error handling and cleanup
  1. D:MAGRC<0 RPCERRS^MAGUERR1(.RESULTS,MAGRC)
  1. Q
  1. ;
  1. ;***** SETS THE IMAGE PROPERTIES (FIELDS IN THE FILE #2005)
  1. ; RPC: MAGG IMAGE SET PROPERTIES
  1. ;
  1. ; .RESULTS Reference to a local variable where the results
  1. ; are returned to.
  1. ;
  1. ; IMGIEN IEN of the image record in the IMAGE file (#2005)
  1. ;
  1. ; [FLAGS] Reserved for future use
  1. ;
  1. ; .PROPVALS Reference to a local array that stores new values
  1. ; for image properties. See description of the MAGG
  1. ; IMAGE SET PROPERTIES remote procedure for details.
  1. ;
  1. ; See the IPDEFS^MAGGA02A for the list of supported
  1. ; properties.
  1. ;
  1. ; Return Values
  1. ; =============
  1. ;
  1. ; Zero value of the first '^'-piece of the RESULTS(0) indicates
  1. ; that an error occurred during the execution of the procedure.
  1. ; In this case, the RESULTS array is formatted as described in the
  1. ; comments to the RPCERRS^MAGUERR1 procedure.
  1. ;
  1. ; Otherwise, the RESULTS(0) contains '1^OK'.
  1. ;
  1. ; Notes
  1. ; =====
  1. ;
  1. ; Properties of images marked as deleted cannot be modified. This
  1. ; entry point returns an error (-41) if the IMGIEN parameter
  1. ; references a deleted image entry.
  1. ;
  1. ; If one of the following fields is updated in the parent or the
  1. ; child of a group that has only one image, then the changes are
  1. ; replicated to the child or parent respectively:
  1. ;
  1. ; SHORT DESCRIPTION (10), TYPE INDEX (42), PROC/EVENT INDEX (43),
  1. ; SPEC/SUBSPEC INDEX (44), ORIGIN INDEX (45), CREATION DATE (110),
  1. ; CONTROLLED IMAGE (112), STATUS (113), and STATUS REASON (113.3).
  1. ;
  1. SETPROPS(RESULTS,IMGIEN,FLAGS,PROPVALS) ;RPC [MAGG IMAGE SET PROPERTIES]
  1. N MAGNODE,MAGRC
  1. D CLEAR^MAGUERR(1)
  1. K RESULTS S RESULTS(0)="1^Ok"
  1. S MAGRC=0
  1. ;
  1. D
  1. . N FLD,IENS,IMGIEN1,NAME,MAGFDA,MAGMSG,MISC,PROPDEFS
  1. . ;=== Set up the error handler
  1. . N $ESTACK,$ETRAP D SETDEFEH^MAGUERR("MAGRC")
  1. . ;
  1. . ;=== Check the record IEN
  1. . I '$$ISVALID^MAGGI11(IMGIEN,.MAGRC) D STORE^MAGUERR(MAGRC) Q
  1. . ;
  1. . ;=== Load definitions of parameters and properties
  1. . S MAGRC=$$LDMPDEFS^MAGUTL01(.PROPDEFS,"IPDEFS^MAGGA02A","W")
  1. . Q:MAGRC<0
  1. . ;
  1. . ;=== Validate the new property values
  1. . S MAGRC=$$RPCMISC^MAGUTL02(.PROPVALS,.MISC,.PROPDEFS,"UV")
  1. . Q:MAGRC<0
  1. . ;
  1. . ;=== Prepare the new data
  1. . S IENS=IMGIEN_","
  1. . S NAME=""
  1. . F S NAME=$O(MISC(NAME)) Q:NAME="" D
  1. . . ;--- Check the file and field numbers and skip parameters
  1. . . ;--- that should not be stored in the IMAGE file (#2005)
  1. . . Q:$P($G(PROPDEFS("N",NAME)),U)'=2005
  1. . . S FLD=$P(PROPDEFS("N",NAME),U,2) Q:FLD'>0
  1. . . ;--- Store the value into the Fileman DBS buffer
  1. . . S MAGFDA(2005,IENS,FLD)=MISC(NAME,"I")
  1. . . Q
  1. . Q:$D(MAGFDA)<10
  1. . ;
  1. . ;=== Check for the group of one and replicate the changes
  1. . S IMGIEN1=$$REPLIC^MAGGA02A(IMGIEN,.MAGFDA)
  1. . I IMGIEN1<0 S MAGRC=IMGIEN1 Q
  1. . ;
  1. . ;=== Patch 117 Check for the STATUS field in the group and set just
  1. . ;=== the first child instead - over protection
  1. . D STATUS1^MAGGA02A(IMGIEN,.MAGFDA)
  1. . I IMGIEN1<0 S MAGRC=IMGIEN1 Q
  1. . ;
  1. . ;=== Lock the image record(s)
  1. . S MAGNODE=$NA(^MAG(2005,IMGIEN))
  1. . S:IMGIEN1>0 MAGNODE="("_MAGNODE_","_$NA(^MAG(2005,IMGIEN1))_")"
  1. . D LOCK^DILF(MAGNODE) E D K MAGNODE Q
  1. . . S MAGRC=$$ERROR^MAGUERR(-21,,"image (IEN="_IMGIEN_")")
  1. . . Q
  1. . ;
  1. . ;=== Check if the image record exists
  1. . I $$ISDEL^MAGGI11(IMGIEN,.MAGRC) D Q
  1. . . S MAGRC=$$ERROR^MAGUERR(-41,,IMGIEN)
  1. . . Q
  1. . I MAGRC<0 D STORE^MAGUERR(MAGRC) Q
  1. . ;
  1. . ;=== Update the image record
  1. . D FILE^DIE(,"MAGFDA","MAGMSG")
  1. . I $G(DIERR) S MAGRC=$$DBS^MAGUERR("MAGMSG",2005,IENS) Q
  1. ;
  1. ;=== Error handling and cleanup
  1. X:$G(MAGNODE)'="" "L -"_MAGNODE
  1. D:MAGRC<0 RPCERRS^MAGUERR1(.RESULTS,MAGRC)
  1. Q