- 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 Apr 23, 2025@18:09:21 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
