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

MAGUTL04.m

Go to the documentation of this file. 
  1. MAGUTL04 ;WOIFO/SG - FIELD AUDIT UTILITIES ; 3/9/09 12:53pm
  1.  ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
  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.  ;; |                                                               |
  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.  ;##### RETRIEVES VALUE OF THE SINGLE FIELD
  1.  ;
  1.  ; FILE          File number
  1.  ;
  1.  ; IENS          Standard IENS indicating internal entry numbers
  1.  ;
  1.  ; FIELD         Field number. Neither field names nor extended
  1.  ;               pointer relational syntax (i.e. POINTER:FIELD)
  1.  ;               are supported.
  1.  ;
  1.  ; [FLAGS]       Flags to control processing (can be combined):
  1.  ;
  1.  ;                 I  Return the internal value (by default,
  1.  ;                    external value is returned).
  1.  ;
  1.  ;                 Z  Zero node included for word processing fields
  1.  ;                    on target array.
  1.  ;
  1.  ; [MAG8BUF]     The root of an array into which word processing
  1.  ;               text is copied.
  1.  ;
  1.  ; [MAG8MSG]     Closed root into which the error messages are put.
  1.  ;               If this parameter is not passed, the messages are
  1.  ;               put into nodes descendent from ^TMP.
  1.  ;
  1.  ; [ADT]         Date/time (internal FileMan value) for retrieving
  1.  ;               the previous value. By default ($G(ADT)'>0), audit
  1.  ;               checks are not performed and the current value is
  1.  ;               returned.
  1.  ;
  1.  ; Return Values
  1.  ; =============
  1.  ;             - Field value (internal or external, depending
  1.  ;               on the flags)
  1.  ;
  1.  ;             - If data exists for a word processing field, then
  1.  ;               this function returns the resolved TARGET_ROOT.
  1.  ;               Otherwise, null is returned.
  1.  ; 
  1.  ; Notes
  1.  ; =====
  1.  ;
  1.  ; See the FileMan Programmer Manual for more details.
  1.  ;
  1. GET1(FILE,IENS,FIELD,FLAGS,MAG8BUF,MAG8MSG,ADT) ;
  1.  N VAL
  1.  ;--- Get the current value
  1.  S VAL=$$GET1^DIQ(FILE,IENS,FIELD,$G(FLAGS),$G(MAG8BUF),$G(MAG8MSG))
  1.  I $G(ADT)>0  D:'$G(DIERR)
  1.  . N MAG8AUDIT,MAGMSG,NODE,OLDVAL,SUBFILE,TMP
  1.  . D INIT(.MAG8AUDIT)
  1.  . ;--- Check if the file is audited
  1.  . S SUBFILE=+$G(MAG8AUDIT(FILE))  Q:SUBFILE'>0
  1.  . ;--- Check for the previous value
  1.  . S NODE=$$ROOT^DILFD(SUBFILE,","_IENS,1)
  1.  . Q:'$$GETPFV(.OLDVAL,NODE,FIELD,ADT)
  1.  . ;--- Return the old value in requested format
  1.  . S VAL=$S($G(FLAGS)["I":OLDVAL,1:OLDVAL("E"))
  1.  . Q
  1.  ;---
  1.  Q VAL
  1.  ;
  1.  ;+++++ GETS THE PREVIOUS FIELD VALUE (FROM THE AUDIT MULTIPLE)
  1.  ;
  1.  ; .VAL(         Reference to a local variable where the internal
  1.  ;               value is returned. 
  1.  ;
  1.  ;   "E")        External value
  1.  ;
  1.  ; NODE          Closed root of the audit multiple that stores
  1.  ;               previous values of the fields of this record.
  1.  ;
  1.  ; FIELD         Field number
  1.  ;
  1.  ; ADT           Date/time for the previous value
  1.  ;
  1.  ; Return Values
  1.  ; =============
  1.  ;            0  No previous value (the VAL parameter is unchanged)
  1.  ;            1  The previous value is returned in the VAL parameter
  1.  ; 
  1.  ; Notes
  1.  ; =====
  1.  ;
  1.  ; This is an internal entry point. Do not call it from outside
  1.  ; of this routine.
  1.  ;
  1. GETPFV(VAL,NODE,FIELD,ADT) ;
  1.  N UIEN,UTS
  1.  S UTS=$O(@NODE@("FD",FIELD,+ADT))  Q:UTS="" 0
  1.  S UIEN=$O(@NODE@("FD",FIELD,UTS,""))  Q:UIEN="" 0
  1.  Q:'$D(@NODE@(UIEN)) 0
  1.  S VAL=$G(@NODE@(UIEN,1)),VAL("E")=$G(@NODE@(UIEN,2))
  1.  ;--- If there is no external value, then it is the same as the
  1.  ;--- internal one (see the AUDIT^MAGUXRF for more details)
  1.  S:VAL("E")="" VAL("E")=VAL
  1.  Q 1
  1.  ;
  1.  ;##### RETRIEVES VALUES OF ONE OR MORE FIELDS
  1.  ;
  1.  ; FILE          File number
  1.  ;
  1.  ; IENS          Standard IENS indicating internal entry numbers
  1.  ;
  1.  ; FLDLST        Field number(s). Can be one of the following:
  1.  ;                 -  A single field number
  1.  ;                 -  A list of field numbers, separated by semicolons
  1.  ;                 -  A range of field numbers, in the form M:N, where
  1.  ;                    M and N are the end points of the inclusive
  1.  ;                    range. All field numbers within this range are
  1.  ;                    retrieved.
  1.  ;                 -  * for all fields at the top level
  1.  ;                    (no sub-multiple record).
  1.  ;                 -  ** for all fields including all fields and data 
  1.  ;                    in sub-multiple fields.
  1.  ;                 -  Field number of a multiple followed by an *
  1.  ;                    to indicate all fields and records in the
  1.  ;                    sub-multiple for that field.
  1.  ;
  1.  ; [FLAGS]       Flags to control processing (can be combined):
  1.  ;
  1.  ;                 E  Returns external values in nodes ending
  1.  ;                    with "E".
  1.  ;
  1.  ;                 I  Returns internal values in nodes ending with
  1.  ;                    "I". By default, external are returned.
  1.  ;
  1.  ;                 Z  Word processing fields include zero nodes.
  1.  ;
  1.  ; [MAG8BUF]     The closed root of the output array.
  1.  ;
  1.  ; [MAG8MSG]     Closed root into which the error messages are put.
  1.  ;               If this parameter is not passed, the messages are
  1.  ;               put into nodes descendent from ^TMP.
  1.  ;
  1.  ; [ADT]         Date/time (internal FileMan value) for retrieving
  1.  ;               previous values of the fields. By default
  1.  ;               ($G(ADT)'>0), audit checks are not performed and
  1.  ;               the current values are returned.
  1.  ; 
  1.  ; Notes
  1.  ; =====
  1.  ;
  1.  ; See the FileMan Programmer Manual for more details.
  1.  ;
  1. GETS(FILE,IENS,FLDLST,FLAGS,MAG8BUF,MAG8MSG,ADT) ;
  1.  ;--- Flags N and R are not supported since the code needs
  1.  ;--- numbers of all requested fields in the output array
  1.  S FLAGS=$TR($G(FLAGS),"NR")
  1.  ;--- Get current values
  1.  D GETS^DIQ(FILE,IENS,FLDLST,$G(FLAGS),MAG8BUF,$G(MAG8MSG))
  1.  I $G(ADT)>0  D:'$G(DIERR)
  1.  . N FLD,MAG8AUDIT,MAGMSG,NODE,SUBFILE,TMP
  1.  . D INIT(.MAG8AUDIT)
  1.  . ;--- Check if the file is audited
  1.  . S SUBFILE=+$G(MAG8AUDIT(FILE))  Q:SUBFILE'>0
  1.  . ;--- Check for previous values
  1.  . S FLAGS=$G(FLAGS)
  1.  . S NODE=$$ROOT^DILFD(SUBFILE,","_IENS,1)
  1.  . S FLD=""
  1.  . F  S FLD=$O(@MAG8BUF@(FILE,IENS,FLD))  Q:FLD=""  D
  1.  . . Q:'$$GETPFV(.OLDVAL,NODE,FLD,ADT)
  1.  . . I FLAGS'["E",FLAGS'["I"  D  Q
  1.  . . . S @MAG8BUF@(FILE,IENS,FLD)=OLDVAL("E")
  1.  . . S:FLAGS["E" @MAG8BUF@(FILE,IENS,FLD,"E")=OLDVAL("E")
  1.  . . S:FLAGS["I" @MAG8BUF@(FILE,IENS,FLD,"I")=OLDVAL
  1.  . . Q
  1.  . Q
  1.  ;---
  1.  Q
  1.  ;
  1.  ;+++++ INITIALIZES AUDIT PARAMETERS
  1. INIT(AUDIT) ;
  1.  S AUDIT(2005)=2005.099
  1.  S AUDIT(2005.1)=2005.199
  1.  Q
  1.  ;
  1.  ;##### RETURNS THE LAST AUDIT RECORD FOR THE IMAGE RECORD FIELD
  1.  ;
  1.  ; MAGFILE       Image file number (2005 or 2005.1)
  1.  ;
  1.  ; IENS          Standard IENS indicating internal entry number
  1.  ;
  1.  ; FIELD         Field number
  1.  ;
  1.  ; Return Values
  1.  ; =============
  1.  ;           ""  Invalid parameter(s) or an error
  1.  ;
  1.  ;            0  Record creation info (field value has not changed)
  1.  ;                 ^01: 0
  1.  ;                 ^02: Value of the DATE/TIME IMAGE SAVED field (7)
  1.  ;                 ^03: Value of the IMAGE SAVE BY field (8)
  1.  ;                
  1.  ;           >0  Last audit record for the field
  1.  ;                 ^01: IEN of the audit record
  1.  ;                 ^02: Date/time (FileMan)
  1.  ;                 ^03: User IEN (DUZ)
  1.  ;
  1. LASTAUDT(MAGFILE,IENS,FIELD) ;
  1.  Q:$G(IENS)'>0 ""
  1.  N BUF,FDT,IEN,NODE
  1.  S NODE=$NA(^MAG(MAGFILE,+IENS))
  1.  ;
  1.  ;--- Get the last audit record for the field
  1.  D
  1.  . S FDT=$O(@NODE@(99,"FD",FIELD,""),-1)      Q:FDT=""
  1.  . S IEN=$O(@NODE@(99,"FD",FIELD,FDT,""),-1)  Q:IEN=""
  1.  . S BUF=$G(@NODE@(99,IEN,0))
  1.  . Q
  1.  Q:$G(BUF)'="" IEN_U_$P(BUF,U)_U_$P(BUF,U,3)
  1.  ;
  1.  ;--- If the field has not been updated, return record creation info
  1.  S BUF=$G(@NODE@(2))
  1.  Q "0"_U_$P(BUF,U)_U_$P(BUF,U,2)