FBAAAUD ;WCIOFO/SAB - FEE BASIS FILE 161.01 DATA AUDIT ;3/26/2014
;;3.5;FEE BASIS;**151**;JAN 30, 1995;Build 14
;;Per VA Directive 6402, this routine should not be modified.
Q
;
AUD(FBSET) ; audit of selected fields in sub-file 161.01
; called by set and kill logic of AUD mumps x-ref on sub-file 161.01
; input
; FBSET = 0 or 1, =true if set logic and =false if kill logic
; also variables from FileMan x-ref
; DA(1) = IEN of record in file 161
; DA = IEN of record in sub-file 161.01
; X1(#) = old values of cross-referenced fields
; X2(#) = new values of cross-referenced fields
N FBDT,FBI,FBFDA,FBFIELDL
; list of cross-referenced fields in order number
S FBFIELDL=".01^.02^.06^.07^.095"
S FBDT=$$NOW^XLFDT()
;
; if kill logic and new value of .01 field null then record was deleted
; and no need to proceed since audit multiple is stored in record
I 'FBSET,X2(1)="" Q
;
; if old and new field values are different then save change in audit
; loop thru audited fields
F FBI=1:1:5 D
. ; if kill logic and value was deleted then save audit
. I 'FBSET,X1(FBI)'=X2(FBI),X2(FBI)="" D SAVE
. ; if set logic and value was entered or changed then save audit
. I FBSET,X1(FBI)'=X2(FBI),X2(FBI)'="" D SAVE
Q
;
SAVE ;
N FBFDA,FBIENS
S FBIENS="+1,"_DA_","_DA(1)_","
S FBFDA(161.193,FBIENS,.01)=FBDT ; CHANGED DATE/TIME
S FBFDA(161.193,FBIENS,1)=$P(FBFIELDL,"^",FBI) ; FIELD
S FBFDA(161.193,FBIENS,2)=X1(FBI) ; OLD VALUE
S FBFDA(161.193,FBIENS,3)=X2(FBI) ; NEW VALUE
S FBFDA(161.193,FBIENS,4)=DUZ ; CHANGED BY
D UPDATE^DIE("","FBFDA")
Q
;
OUTX ; output transform
; called by OLD VALUE and NEW VALUE fields in the DATA AUDIT multiple
; in the AUTHORIZATION multiple of the FEE BASIS PATIENT (#161) file.
; input
; Y = value to transform
; D0 = required internal entry number, top level
; D1 = optional internal entry number, one level below
; D2 = optional internal entry number, two levels below
; DIC = optional file/sub-file root
; output
; Y = external value for Y when available, else the input value
;
Q:'$G(D0) ; must have at least one IEN
Q:$G(Y)="" ; must have internal value to transform
;
N FBFLD,FBNODE,FBY
;
; determine 0-node of entry in DATA AUDIT
S FBNODE=""
I $G(D2),$G(D1) S FBNODE="^FBAAA("_D0_",1,"_D1_",""LOG2"","_D2_",0)"
I '$G(D2),$G(D1),$E($G(DIC))="^" S FBNODE=DIC_D0_",""LOG2"","_D1_",0)"
I '$G(D2),'$G(D1),$E($G(DIC))="^" S FBNODE=DIC_D0_",0)"
Q:FBNODE=""
;
; obtain value of FIELD
S FBFLD=$P($G(@FBNODE),"^",2)
Q:FBFLD=""
;
; obtain external value of Y for the field
S FBY=$$EXTERNAL^DILFD(161.01,FBFLD,"",Y)
S:FBY]"" Y=FBY ; return external value in Y
Q
;
;FBAAAUD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAAUD 2777 printed Nov 22, 2024@17:05:02 Page 2
FBAAAUD ;WCIOFO/SAB - FEE BASIS FILE 161.01 DATA AUDIT ;3/26/2014
+1 ;;3.5;FEE BASIS;**151**;JAN 30, 1995;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
AUD(FBSET) ; audit of selected fields in sub-file 161.01
+1 ; called by set and kill logic of AUD mumps x-ref on sub-file 161.01
+2 ; input
+3 ; FBSET = 0 or 1, =true if set logic and =false if kill logic
+4 ; also variables from FileMan x-ref
+5 ; DA(1) = IEN of record in file 161
+6 ; DA = IEN of record in sub-file 161.01
+7 ; X1(#) = old values of cross-referenced fields
+8 ; X2(#) = new values of cross-referenced fields
+9 NEW FBDT,FBI,FBFDA,FBFIELDL
+10 ; list of cross-referenced fields in order number
+11 SET FBFIELDL=".01^.02^.06^.07^.095"
+12 SET FBDT=$$NOW^XLFDT()
+13 ;
+14 ; if kill logic and new value of .01 field null then record was deleted
+15 ; and no need to proceed since audit multiple is stored in record
+16 IF 'FBSET
IF X2(1)=""
QUIT
+17 ;
+18 ; if old and new field values are different then save change in audit
+19 ; loop thru audited fields
+20 FOR FBI=1:1:5
Begin DoDot:1
+21 ; if kill logic and value was deleted then save audit
+22 IF 'FBSET
IF X1(FBI)'=X2(FBI)
IF X2(FBI)=""
DO SAVE
+23 ; if set logic and value was entered or changed then save audit
+24 IF FBSET
IF X1(FBI)'=X2(FBI)
IF X2(FBI)'=""
DO SAVE
End DoDot:1
+25 QUIT
+26 ;
SAVE ;
+1 NEW FBFDA,FBIENS
+2 SET FBIENS="+1,"_DA_","_DA(1)_","
+3 ; CHANGED DATE/TIME
SET FBFDA(161.193,FBIENS,.01)=FBDT
+4 ; FIELD
SET FBFDA(161.193,FBIENS,1)=$PIECE(FBFIELDL,"^",FBI)
+5 ; OLD VALUE
SET FBFDA(161.193,FBIENS,2)=X1(FBI)
+6 ; NEW VALUE
SET FBFDA(161.193,FBIENS,3)=X2(FBI)
+7 ; CHANGED BY
SET FBFDA(161.193,FBIENS,4)=DUZ
+8 DO UPDATE^DIE("","FBFDA")
+9 QUIT
+10 ;
OUTX ; output transform
+1 ; called by OLD VALUE and NEW VALUE fields in the DATA AUDIT multiple
+2 ; in the AUTHORIZATION multiple of the FEE BASIS PATIENT (#161) file.
+3 ; input
+4 ; Y = value to transform
+5 ; D0 = required internal entry number, top level
+6 ; D1 = optional internal entry number, one level below
+7 ; D2 = optional internal entry number, two levels below
+8 ; DIC = optional file/sub-file root
+9 ; output
+10 ; Y = external value for Y when available, else the input value
+11 ;
+12 ; must have at least one IEN
if '$GET(D0)
QUIT
+13 ; must have internal value to transform
if $GET(Y)=""
QUIT
+14 ;
+15 NEW FBFLD,FBNODE,FBY
+16 ;
+17 ; determine 0-node of entry in DATA AUDIT
+18 SET FBNODE=""
+19 IF $GET(D2)
IF $GET(D1)
SET FBNODE="^FBAAA("_D0_",1,"_D1_",""LOG2"","_D2_",0)"
+20 IF '$GET(D2)
IF $GET(D1)
IF $EXTRACT($GET(DIC))="^"
SET FBNODE=DIC_D0_",""LOG2"","_D1_",0)"
+21 IF '$GET(D2)
IF '$GET(D1)
IF $EXTRACT($GET(DIC))="^"
SET FBNODE=DIC_D0_",0)"
+22 if FBNODE=""
QUIT
+23 ;
+24 ; obtain value of FIELD
+25 SET FBFLD=$PIECE($GET(@FBNODE),"^",2)
+26 if FBFLD=""
QUIT
+27 ;
+28 ; obtain external value of Y for the field
+29 SET FBY=$$EXTERNAL^DILFD(161.01,FBFLD,"",Y)
+30 ; return external value in Y
if FBY]""
SET Y=FBY
+31 QUIT
+32 ;
+33 ;FBAAAUD
