MAGUTL04 ;WOIFO/SG - FIELD AUDIT UTILITIES ; 3/9/09 12:53pm
;;3.0;IMAGING;**93**;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
;
;##### RETRIEVES VALUE OF THE SINGLE FIELD
;
; FILE File number
;
; IENS Standard IENS indicating internal entry numbers
;
; FIELD Field number. Neither field names nor extended
; pointer relational syntax (i.e. POINTER:FIELD)
; are supported.
;
; [FLAGS] Flags to control processing (can be combined):
;
; I Return the internal value (by default,
; external value is returned).
;
; Z Zero node included for word processing fields
; on target array.
;
; [MAG8BUF] The root of an array into which word processing
; text is copied.
;
; [MAG8MSG] Closed root into which the error messages are put.
; If this parameter is not passed, the messages are
; put into nodes descendent from ^TMP.
;
; [ADT] Date/time (internal FileMan value) for retrieving
; the previous value. By default ($G(ADT)'>0), audit
; checks are not performed and the current value is
; returned.
;
; Return Values
; =============
; - Field value (internal or external, depending
; on the flags)
;
; - If data exists for a word processing field, then
; this function returns the resolved TARGET_ROOT.
; Otherwise, null is returned.
;
; Notes
; =====
;
; See the FileMan Programmer Manual for more details.
;
GET1(FILE,IENS,FIELD,FLAGS,MAG8BUF,MAG8MSG,ADT) ;
N VAL
;--- Get the current value
S VAL=$$GET1^DIQ(FILE,IENS,FIELD,$G(FLAGS),$G(MAG8BUF),$G(MAG8MSG))
I $G(ADT)>0 D:'$G(DIERR)
. N MAG8AUDIT,MAGMSG,NODE,OLDVAL,SUBFILE,TMP
. D INIT(.MAG8AUDIT)
. ;--- Check if the file is audited
. S SUBFILE=+$G(MAG8AUDIT(FILE)) Q:SUBFILE'>0
. ;--- Check for the previous value
. S NODE=$$ROOT^DILFD(SUBFILE,","_IENS,1)
. Q:'$$GETPFV(.OLDVAL,NODE,FIELD,ADT)
. ;--- Return the old value in requested format
. S VAL=$S($G(FLAGS)["I":OLDVAL,1:OLDVAL("E"))
. Q
;---
Q VAL
;
;+++++ GETS THE PREVIOUS FIELD VALUE (FROM THE AUDIT MULTIPLE)
;
; .VAL( Reference to a local variable where the internal
; value is returned.
;
; "E") External value
;
; NODE Closed root of the audit multiple that stores
; previous values of the fields of this record.
;
; FIELD Field number
;
; ADT Date/time for the previous value
;
; Return Values
; =============
; 0 No previous value (the VAL parameter is unchanged)
; 1 The previous value is returned in the VAL parameter
;
; Notes
; =====
;
; This is an internal entry point. Do not call it from outside
; of this routine.
;
GETPFV(VAL,NODE,FIELD,ADT) ;
N UIEN,UTS
S UTS=$O(@NODE@("FD",FIELD,+ADT)) Q:UTS="" 0
S UIEN=$O(@NODE@("FD",FIELD,UTS,"")) Q:UIEN="" 0
Q:'$D(@NODE@(UIEN)) 0
S VAL=$G(@NODE@(UIEN,1)),VAL("E")=$G(@NODE@(UIEN,2))
;--- If there is no external value, then it is the same as the
;--- internal one (see the AUDIT^MAGUXRF for more details)
S:VAL("E")="" VAL("E")=VAL
Q 1
;
;##### RETRIEVES VALUES OF ONE OR MORE FIELDS
;
; FILE File number
;
; IENS Standard IENS indicating internal entry numbers
;
; FLDLST Field number(s). Can be one of the following:
; - A single field number
; - A list of field numbers, separated by semicolons
; - A range of field numbers, in the form M:N, where
; M and N are the end points of the inclusive
; range. All field numbers within this range are
; retrieved.
; - * for all fields at the top level
; (no sub-multiple record).
; - ** for all fields including all fields and data
; in sub-multiple fields.
; - Field number of a multiple followed by an *
; to indicate all fields and records in the
; sub-multiple for that field.
;
; [FLAGS] Flags to control processing (can be combined):
;
; E Returns external values in nodes ending
; with "E".
;
; I Returns internal values in nodes ending with
; "I". By default, external are returned.
;
; Z Word processing fields include zero nodes.
;
; [MAG8BUF] The closed root of the output array.
;
; [MAG8MSG] Closed root into which the error messages are put.
; If this parameter is not passed, the messages are
; put into nodes descendent from ^TMP.
;
; [ADT] Date/time (internal FileMan value) for retrieving
; previous values of the fields. By default
; ($G(ADT)'>0), audit checks are not performed and
; the current values are returned.
;
; Notes
; =====
;
; See the FileMan Programmer Manual for more details.
;
GETS(FILE,IENS,FLDLST,FLAGS,MAG8BUF,MAG8MSG,ADT) ;
;--- Flags N and R are not supported since the code needs
;--- numbers of all requested fields in the output array
S FLAGS=$TR($G(FLAGS),"NR")
;--- Get current values
D GETS^DIQ(FILE,IENS,FLDLST,$G(FLAGS),MAG8BUF,$G(MAG8MSG))
I $G(ADT)>0 D:'$G(DIERR)
. N FLD,MAG8AUDIT,MAGMSG,NODE,SUBFILE,TMP
. D INIT(.MAG8AUDIT)
. ;--- Check if the file is audited
. S SUBFILE=+$G(MAG8AUDIT(FILE)) Q:SUBFILE'>0
. ;--- Check for previous values
. S FLAGS=$G(FLAGS)
. S NODE=$$ROOT^DILFD(SUBFILE,","_IENS,1)
. S FLD=""
. F S FLD=$O(@MAG8BUF@(FILE,IENS,FLD)) Q:FLD="" D
. . Q:'$$GETPFV(.OLDVAL,NODE,FLD,ADT)
. . I FLAGS'["E",FLAGS'["I" D Q
. . . S @MAG8BUF@(FILE,IENS,FLD)=OLDVAL("E")
. . S:FLAGS["E" @MAG8BUF@(FILE,IENS,FLD,"E")=OLDVAL("E")
. . S:FLAGS["I" @MAG8BUF@(FILE,IENS,FLD,"I")=OLDVAL
. . Q
. Q
;---
Q
;
;+++++ INITIALIZES AUDIT PARAMETERS
INIT(AUDIT) ;
S AUDIT(2005)=2005.099
S AUDIT(2005.1)=2005.199
Q
;
;##### RETURNS THE LAST AUDIT RECORD FOR THE IMAGE RECORD FIELD
;
; MAGFILE Image file number (2005 or 2005.1)
;
; IENS Standard IENS indicating internal entry number
;
; FIELD Field number
;
; Return Values
; =============
; "" Invalid parameter(s) or an error
;
; 0 Record creation info (field value has not changed)
; ^01: 0
; ^02: Value of the DATE/TIME IMAGE SAVED field (7)
; ^03: Value of the IMAGE SAVE BY field (8)
;
; >0 Last audit record for the field
; ^01: IEN of the audit record
; ^02: Date/time (FileMan)
; ^03: User IEN (DUZ)
;
LASTAUDT(MAGFILE,IENS,FIELD) ;
Q:$G(IENS)'>0 ""
N BUF,FDT,IEN,NODE
S NODE=$NA(^MAG(MAGFILE,+IENS))
;
;--- Get the last audit record for the field
D
. S FDT=$O(@NODE@(99,"FD",FIELD,""),-1) Q:FDT=""
. S IEN=$O(@NODE@(99,"FD",FIELD,FDT,""),-1) Q:IEN=""
. S BUF=$G(@NODE@(99,IEN,0))
. Q
Q:$G(BUF)'="" IEN_U_$P(BUF,U)_U_$P(BUF,U,3)
;
;--- If the field has not been updated, return record creation info
S BUF=$G(@NODE@(2))
Q "0"_U_$P(BUF,U)_U_$P(BUF,U,2)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUTL04 8670 printed Dec 13, 2024@02:09:07 Page 2
MAGUTL04 ;WOIFO/SG - FIELD AUDIT UTILITIES ; 3/9/09 12:53pm
+1 ;;3.0;IMAGING;**93**;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 ;##### RETRIEVES VALUE OF THE SINGLE FIELD
+21 ;
+22 ; FILE File number
+23 ;
+24 ; IENS Standard IENS indicating internal entry numbers
+25 ;
+26 ; FIELD Field number. Neither field names nor extended
+27 ; pointer relational syntax (i.e. POINTER:FIELD)
+28 ; are supported.
+29 ;
+30 ; [FLAGS] Flags to control processing (can be combined):
+31 ;
+32 ; I Return the internal value (by default,
+33 ; external value is returned).
+34 ;
+35 ; Z Zero node included for word processing fields
+36 ; on target array.
+37 ;
+38 ; [MAG8BUF] The root of an array into which word processing
+39 ; text is copied.
+40 ;
+41 ; [MAG8MSG] Closed root into which the error messages are put.
+42 ; If this parameter is not passed, the messages are
+43 ; put into nodes descendent from ^TMP.
+44 ;
+45 ; [ADT] Date/time (internal FileMan value) for retrieving
+46 ; the previous value. By default ($G(ADT)'>0), audit
+47 ; checks are not performed and the current value is
+48 ; returned.
+49 ;
+50 ; Return Values
+51 ; =============
+52 ; - Field value (internal or external, depending
+53 ; on the flags)
+54 ;
+55 ; - If data exists for a word processing field, then
+56 ; this function returns the resolved TARGET_ROOT.
+57 ; Otherwise, null is returned.
+58 ;
+59 ; Notes
+60 ; =====
+61 ;
+62 ; See the FileMan Programmer Manual for more details.
+63 ;
GET1(FILE,IENS,FIELD,FLAGS,MAG8BUF,MAG8MSG,ADT) ;
+1 NEW VAL
+2 ;--- Get the current value
+3 SET VAL=$$GET1^DIQ(FILE,IENS,FIELD,$GET(FLAGS),$GET(MAG8BUF),$GET(MAG8MSG))
+4 IF $GET(ADT)>0
if '$GET(DIERR)
Begin DoDot:1
+5 NEW MAG8AUDIT,MAGMSG,NODE,OLDVAL,SUBFILE,TMP
+6 DO INIT(.MAG8AUDIT)
+7 ;--- Check if the file is audited
+8 SET SUBFILE=+$GET(MAG8AUDIT(FILE))
if SUBFILE'>0
QUIT
+9 ;--- Check for the previous value
+10 SET NODE=$$ROOT^DILFD(SUBFILE,","_IENS,1)
+11 if '$$GETPFV(.OLDVAL,NODE,FIELD,ADT)
QUIT
+12 ;--- Return the old value in requested format
+13 SET VAL=$SELECT($GET(FLAGS)["I":OLDVAL,1:OLDVAL("E"))
+14 QUIT
End DoDot:1
+15 ;---
+16 QUIT VAL
+17 ;
+18 ;+++++ GETS THE PREVIOUS FIELD VALUE (FROM THE AUDIT MULTIPLE)
+19 ;
+20 ; .VAL( Reference to a local variable where the internal
+21 ; value is returned.
+22 ;
+23 ; "E") External value
+24 ;
+25 ; NODE Closed root of the audit multiple that stores
+26 ; previous values of the fields of this record.
+27 ;
+28 ; FIELD Field number
+29 ;
+30 ; ADT Date/time for the previous value
+31 ;
+32 ; Return Values
+33 ; =============
+34 ; 0 No previous value (the VAL parameter is unchanged)
+35 ; 1 The previous value is returned in the VAL parameter
+36 ;
+37 ; Notes
+38 ; =====
+39 ;
+40 ; This is an internal entry point. Do not call it from outside
+41 ; of this routine.
+42 ;
GETPFV(VAL,NODE,FIELD,ADT) ;
+1 NEW UIEN,UTS
+2 SET UTS=$ORDER(@NODE@("FD",FIELD,+ADT))
if UTS=""
QUIT 0
+3 SET UIEN=$ORDER(@NODE@("FD",FIELD,UTS,""))
if UIEN=""
QUIT 0
+4 if '$DATA(@NODE@(UIEN))
QUIT 0
+5 SET VAL=$GET(@NODE@(UIEN,1))
SET VAL("E")=$GET(@NODE@(UIEN,2))
+6 ;--- If there is no external value, then it is the same as the
+7 ;--- internal one (see the AUDIT^MAGUXRF for more details)
+8 if VAL("E")=""
SET VAL("E")=VAL
+9 QUIT 1
+10 ;
+11 ;##### RETRIEVES VALUES OF ONE OR MORE FIELDS
+12 ;
+13 ; FILE File number
+14 ;
+15 ; IENS Standard IENS indicating internal entry numbers
+16 ;
+17 ; FLDLST Field number(s). Can be one of the following:
+18 ; - A single field number
+19 ; - A list of field numbers, separated by semicolons
+20 ; - A range of field numbers, in the form M:N, where
+21 ; M and N are the end points of the inclusive
+22 ; range. All field numbers within this range are
+23 ; retrieved.
+24 ; - * for all fields at the top level
+25 ; (no sub-multiple record).
+26 ; - ** for all fields including all fields and data
+27 ; in sub-multiple fields.
+28 ; - Field number of a multiple followed by an *
+29 ; to indicate all fields and records in the
+30 ; sub-multiple for that field.
+31 ;
+32 ; [FLAGS] Flags to control processing (can be combined):
+33 ;
+34 ; E Returns external values in nodes ending
+35 ; with "E".
+36 ;
+37 ; I Returns internal values in nodes ending with
+38 ; "I". By default, external are returned.
+39 ;
+40 ; Z Word processing fields include zero nodes.
+41 ;
+42 ; [MAG8BUF] The closed root of the output array.
+43 ;
+44 ; [MAG8MSG] Closed root into which the error messages are put.
+45 ; If this parameter is not passed, the messages are
+46 ; put into nodes descendent from ^TMP.
+47 ;
+48 ; [ADT] Date/time (internal FileMan value) for retrieving
+49 ; previous values of the fields. By default
+50 ; ($G(ADT)'>0), audit checks are not performed and
+51 ; the current values are returned.
+52 ;
+53 ; Notes
+54 ; =====
+55 ;
+56 ; See the FileMan Programmer Manual for more details.
+57 ;
GETS(FILE,IENS,FLDLST,FLAGS,MAG8BUF,MAG8MSG,ADT) ;
+1 ;--- Flags N and R are not supported since the code needs
+2 ;--- numbers of all requested fields in the output array
+3 SET FLAGS=$TRANSLATE($GET(FLAGS),"NR")
+4 ;--- Get current values
+5 DO GETS^DIQ(FILE,IENS,FLDLST,$GET(FLAGS),MAG8BUF,$GET(MAG8MSG))
+6 IF $GET(ADT)>0
if '$GET(DIERR)
Begin DoDot:1
+7 NEW FLD,MAG8AUDIT,MAGMSG,NODE,SUBFILE,TMP
+8 DO INIT(.MAG8AUDIT)
+9 ;--- Check if the file is audited
+10 SET SUBFILE=+$GET(MAG8AUDIT(FILE))
if SUBFILE'>0
QUIT
+11 ;--- Check for previous values
+12 SET FLAGS=$GET(FLAGS)
+13 SET NODE=$$ROOT^DILFD(SUBFILE,","_IENS,1)
+14 SET FLD=""
+15 FOR
SET FLD=$ORDER(@MAG8BUF@(FILE,IENS,FLD))
if FLD=""
QUIT
Begin DoDot:2
+16 if '$$GETPFV(.OLDVAL,NODE,FLD,ADT)
QUIT
+17 IF FLAGS'["E"
IF FLAGS'["I"
Begin DoDot:3
+18 SET @MAG8BUF@(FILE,IENS,FLD)=OLDVAL("E")
End DoDot:3
QUIT
+19 if FLAGS["E"
SET @MAG8BUF@(FILE,IENS,FLD,"E")=OLDVAL("E")
+20 if FLAGS["I"
SET @MAG8BUF@(FILE,IENS,FLD,"I")=OLDVAL
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 ;---
+24 QUIT
+25 ;
+26 ;+++++ INITIALIZES AUDIT PARAMETERS
INIT(AUDIT) ;
+1 SET AUDIT(2005)=2005.099
+2 SET AUDIT(2005.1)=2005.199
+3 QUIT
+4 ;
+5 ;##### RETURNS THE LAST AUDIT RECORD FOR THE IMAGE RECORD FIELD
+6 ;
+7 ; MAGFILE Image file number (2005 or 2005.1)
+8 ;
+9 ; IENS Standard IENS indicating internal entry number
+10 ;
+11 ; FIELD Field number
+12 ;
+13 ; Return Values
+14 ; =============
+15 ; "" Invalid parameter(s) or an error
+16 ;
+17 ; 0 Record creation info (field value has not changed)
+18 ; ^01: 0
+19 ; ^02: Value of the DATE/TIME IMAGE SAVED field (7)
+20 ; ^03: Value of the IMAGE SAVE BY field (8)
+21 ;
+22 ; >0 Last audit record for the field
+23 ; ^01: IEN of the audit record
+24 ; ^02: Date/time (FileMan)
+25 ; ^03: User IEN (DUZ)
+26 ;
LASTAUDT(MAGFILE,IENS,FIELD) ;
+1 if $GET(IENS)'>0
QUIT ""
+2 NEW BUF,FDT,IEN,NODE
+3 SET NODE=$NAME(^MAG(MAGFILE,+IENS))
+4 ;
+5 ;--- Get the last audit record for the field
+6 Begin DoDot:1
+7 SET FDT=$ORDER(@NODE@(99,"FD",FIELD,""),-1)
if FDT=""
QUIT
+8 SET IEN=$ORDER(@NODE@(99,"FD",FIELD,FDT,""),-1)
if IEN=""
QUIT
+9 SET BUF=$GET(@NODE@(99,IEN,0))
+10 QUIT
End DoDot:1
+11 if $GET(BUF)'=""
QUIT IEN_U_$PIECE(BUF,U)_U_$PIECE(BUF,U,3)
+12 ;
+13 ;--- If the field has not been updated, return record creation info
+14 SET BUF=$GET(@NODE@(2))
+15 QUIT "0"_U_$PIECE(BUF,U)_U_$PIECE(BUF,U,2)
