DIET ;SFISC/XAK - DISPLAY INPUT TEMPLATE ALSO DOES AUDITING! ; Jun 05, 2023@14:22:18
;;22.2;VA FileMan;**21,22,27**;Jan 05, 2016;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
N DICMX
I '$D(^DIE(D0,0)) G EXIT
S DICMX="W X,!"
EN ;
N DI,DIET,DIETS,D
S DIET=D0 D GET^DIETED("DIETS")
F D=0:0 S D=$O(DIETS(D)) Q:'D S X=DIETS(D) X DICMX Q:'$D(D)
EXIT S X="" Q
;
;
;
AUD N DP,DG,DPS,DIEX,DIIX,DIANUM ; From ^DICN0 DI*22*49
S DIIX="3^.01^A",DP=+DO(2) D AUDIT:DP>0 Q
AUDIT ;
N C,DIEDA,DIEF,%T,%F,%D,%,Y
I $D(^DD(DP,+$P(DIIX,U,2),"AX")) X ^("AX") Q:'$T
K % S DIEX=X D @+DIIX
K DIIX,DPS,DIEX
Q
3 ;'X' is NEW value
I $D(DG),$D(DIANUM($P(DIIX,U,2))) S Y=X,(DIEX(1),C)=$P(^DD(DP,+$P(DIIX,U,2),0),U,2) D Y^DIQ S @DIANUM($P(DIIX,U,2))=Y K DIANUM($P(DIIX,U,2)) G I
2 ;'X' is OLD value
S:$D(DP(1)) DPS=DP(1) S DIEDA="",DIEF="",%=1,DP(1)=DP,%F=+DP,X=DA
F C=1:1 Q:'$D(^DD(DP(1),0,"UP")) S %F=^("UP"),%=$O(^DD(%F,"SB",DP(1),0)) G Q:'$D(DA(C)) S DIEDA=DA(C)_","_DIEDA,DIEF=%_","_DIEF,DP(1)=%F
D ADD I $D(DG),+DIIX=2 S DIANUM($P(DIIX,U,2))="^DIA("_%F_","_+Y_",3)"
S (DIEX(1),C)=$P(^DD(DP,+$P(DIIX,U,2),0),U,2),Y=DIEX D
.N %F,%D,DA,DIEX,DP,DPS
.D Y^DIQ
S ^DIA(%F,"B",DIEDA_DA,%D)="",X=DIEX S:$D(DPS) DP(1)=DPS
S ^DIA(%F,%D,0)=DIEDA_DA_U_%T_U_DIEF_+$P(DIIX,U,2)_U_DUZ_U_$P(DIIX,U,3),^(+DIIX)=Y
I I (DIEX(1)["D")!(DIEX(1)["P")!(DIEX(1)["V")!(DIEX(1)["S") S ^(DIIX+.1)=X_U_DIEX(1)
Q Q
;
;
;
;
;
WP(%F,FLD,IENS,DIEFNODE) ;AUDIT WP FIELD FLD IN (SUB)FILE %F
N %,%D,%T,DIIX,X,Y,Z
S %=+$P($G(^DD(%F,FLD,0)),U,2) Q:'% Q:$P($G(^DD(+%,.01,0)),U,2)'["a" Q:$G(^("AUDIT"))="e"&'$O(@DIEFNODE@(0))
S Z=+%,X="",DIIX="3^"_FLD ;p22 define Z=subDD for audit condition ;p27 define DIIX
F Q:'IENS S Y=%F,X=+IENS_","_X,IENS=$P(IENS,",",2,99) Q:'$G(^DD(Y,0,"UP")) S %F=^("UP"),%=$O(^DD(%F,"SB",Y,0)) I % S FLD=%_","_FLD
I $D(^DD(Z,.01,"AX")) D Q:'% ;p21 execute audit condition, quit if false
. N X,Y S X=""
. X ^DD(Z,.01,"AX") S %=$T
S X=$E(X,1,$L(X)-1) D ADD S ^DIA(%F,Y,0)=X_U_%T_U_FLD_U_DUZ,^DIA(%F,"B",X,Y)=""
M ^DIA(%F,Y,2.14)=@DIEFNODE
Q
;
;
;
ACCESSED(%F,REF) ;WILL FLAG ENTRY 'REF' IN FILE '%F' AS BEING ACCESSED BY CURRENT USER, CURRENT TIME, CURRENT OPTION
N Y,X,%T,%D,%,%I,%H
Q:'$G(DUZ)
I '$G(DT) D NOW^%DTC S DT=X,U="^"
Q:'%F!'REF S %F=+%F,(REF,X)=+REF Q:'$D(^DIC(%F))
D ADD ;COMES BACK WITH %T AND Y--THE AUDIT REF
S ^DIA(%F,Y,0)=REF_U_%T_U_.01_U_DUZ_U_U_"i"
S ^DIA(%F,"B",REF,Y)=""
Q
;
;
;
ADD S Y=$O(^DIA(%F,"A"),-1) I 'Y S ^DIA(%F,0)=$P(^DIC(%F,0),U)_" AUDIT^1.1I"
F Y=Y+1:1 I '$D(^(Y)) D LOCK^DILF("^DIA(%F,Y)") I Q:'$D(^(Y)) L -^DIA(%F,Y) ;**PATCH 147
S ^(Y,0)=X L -^DIA(%F,Y)
S %T=$G(XQY),%D=$S($D(XQORNOD)#2:XQORNOD,$D(HLORNOD)#2:HLORNOD,1:"") I %T!%D S ^DIA(%F,Y,4.1)=%T_U_%D
S $P(^(0),U,3,4)=Y_U_($P(^DIA(%F,0),U,4)+1)
TIME S %D=Y,%T=$$HTFM^DILIBF($H)
S ^DIA(%F,"C",%T,Y)="",^DIA(%F,"D",DUZ,Y)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIET 3154 printed Dec 13, 2024@02:47:18 Page 2
DIET ;SFISC/XAK - DISPLAY INPUT TEMPLATE ALSO DOES AUDITING! ; Jun 05, 2023@14:22:18
+1 ;;22.2;VA FileMan;**21,22,27**;Jan 05, 2016;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 NEW DICMX
+8 IF '$DATA(^DIE(D0,0))
GOTO EXIT
+9 SET DICMX="W X,!"
EN ;
+1 NEW DI,DIET,DIETS,D
+2 SET DIET=D0
DO GET^DIETED("DIETS")
+3 FOR D=0:0
SET D=$ORDER(DIETS(D))
if 'D
QUIT
SET X=DIETS(D)
XECUTE DICMX
if '$DATA(D)
QUIT
EXIT SET X=""
QUIT
+1 ;
+2 ;
+3 ;
AUD ; From ^DICN0 DI*22*49
NEW DP,DG,DPS,DIEX,DIIX,DIANUM
+1 SET DIIX="3^.01^A"
SET DP=+DO(2)
if DP>0
DO AUDIT
QUIT
AUDIT ;
+1 NEW C,DIEDA,DIEF,%T,%F,%D,%,Y
+2 IF $DATA(^DD(DP,+$PIECE(DIIX,U,2),"AX"))
XECUTE ^("AX")
if '$TEST
QUIT
+3 KILL %
SET DIEX=X
DO @+DIIX
+4 KILL DIIX,DPS,DIEX
+5 QUIT
3 ;'X' is NEW value
+1 IF $DATA(DG)
IF $DATA(DIANUM($PIECE(DIIX,U,2)))
SET Y=X
SET (DIEX(1),C)=$PIECE(^DD(DP,+$PIECE(DIIX,U,2),0),U,2)
DO Y^DIQ
SET @DIANUM($PIECE(DIIX,U,2))=Y
KILL DIANUM($PIECE(DIIX,U,2))
GOTO I
2 ;'X' is OLD value
+1 if $DATA(DP(1))
SET DPS=DP(1)
SET DIEDA=""
SET DIEF=""
SET %=1
SET DP(1)=DP
SET %F=+DP
SET X=DA
+2 FOR C=1:1
if '$DATA(^DD(DP(1),0,"UP"))
QUIT
SET %F=^("UP")
SET %=$ORDER(^DD(%F,"SB",DP(1),0))
if '$DATA(DA(C))
GOTO Q
SET DIEDA=DA(C)_","_DIEDA
SET DIEF=%_","_DIEF
SET DP(1)=%F
+3 DO ADD
IF $DATA(DG)
IF +DIIX=2
SET DIANUM($PIECE(DIIX,U,2))="^DIA("_%F_","_+Y_",3)"
+4 SET (DIEX(1),C)=$PIECE(^DD(DP,+$PIECE(DIIX,U,2),0),U,2)
SET Y=DIEX
Begin DoDot:1
+5 NEW %F,%D,DA,DIEX,DP,DPS
+6 DO Y^DIQ
End DoDot:1
+7 SET ^DIA(%F,"B",DIEDA_DA,%D)=""
SET X=DIEX
if $DATA(DPS)
SET DP(1)=DPS
+8 SET ^DIA(%F,%D,0)=DIEDA_DA_U_%T_U_DIEF_+$PIECE(DIIX,U,2)_U_DUZ_U_$PIECE(DIIX,U,3)
SET ^(+DIIX)=Y
I IF (DIEX(1)["D")!(DIEX(1)["P")!(DIEX(1)["V")!(DIEX(1)["S")
SET ^(DIIX+.1)=X_U_DIEX(1)
Q QUIT
+1 ;
+2 ;
+3 ;
+4 ;
+5 ;
WP(%F,FLD,IENS,DIEFNODE) ;AUDIT WP FIELD FLD IN (SUB)FILE %F
+1 NEW %,%D,%T,DIIX,X,Y,Z
+2 SET %=+$PIECE($GET(^DD(%F,FLD,0)),U,2)
if '%
QUIT
if $PIECE($GET(^DD(+%,.01,0)),U,2)'["a"
QUIT
if $GET(^("AUDIT"))="e"&'$ORDER(@DIEFNODE@(0))
QUIT
+3 ;p22 define Z=subDD for audit condition ;p27 define DIIX
SET Z=+%
SET X=""
SET DIIX="3^"_FLD
+4 FOR
if 'IENS
QUIT
SET Y=%F
SET X=+IENS_","_X
SET IENS=$PIECE(IENS,",",2,99)
if '$GET(^DD(Y,0,"UP"))
QUIT
SET %F=^("UP")
SET %=$ORDER(^DD(%F,"SB",Y,0))
IF %
SET FLD=%_","_FLD
+5 ;p21 execute audit condition, quit if false
IF $DATA(^DD(Z,.01,"AX"))
Begin DoDot:1
+6 NEW X,Y
SET X=""
+7 XECUTE ^DD(Z,.01,"AX")
SET %=$TEST
End DoDot:1
if '%
QUIT
+8 SET X=$EXTRACT(X,1,$LENGTH(X)-1)
DO ADD
SET ^DIA(%F,Y,0)=X_U_%T_U_FLD_U_DUZ
SET ^DIA(%F,"B",X,Y)=""
+9 MERGE ^DIA(%F,Y,2.14)=@DIEFNODE
+10 QUIT
+11 ;
+12 ;
+13 ;
ACCESSED(%F,REF) ;WILL FLAG ENTRY 'REF' IN FILE '%F' AS BEING ACCESSED BY CURRENT USER, CURRENT TIME, CURRENT OPTION
+1 NEW Y,X,%T,%D,%,%I,%H
+2 if '$GET(DUZ)
QUIT
+3 IF '$GET(DT)
DO NOW^%DTC
SET DT=X
SET U="^"
+4 if '%F!'REF
QUIT
SET %F=+%F
SET (REF,X)=+REF
if '$DATA(^DIC(%F))
QUIT
+5 ;COMES BACK WITH %T AND Y--THE AUDIT REF
DO ADD
+6 SET ^DIA(%F,Y,0)=REF_U_%T_U_.01_U_DUZ_U_U_"i"
+7 SET ^DIA(%F,"B",REF,Y)=""
+8 QUIT
+9 ;
+10 ;
+11 ;
ADD SET Y=$ORDER(^DIA(%F,"A"),-1)
IF 'Y
SET ^DIA(%F,0)=$PIECE(^DIC(%F,0),U)_" AUDIT^1.1I"
+1 ;**PATCH 147
FOR Y=Y+1:1
IF '$DATA(^(Y))
DO LOCK^DILF("^DIA(%F,Y)")
IF $TEST
if '$DATA(^(Y))
QUIT
LOCK -^DIA(%F,Y)
+2 SET ^(Y,0)=X
LOCK -^DIA(%F,Y)
+3 SET %T=$GET(XQY)
SET %D=$SELECT($DATA(XQORNOD)#2:XQORNOD,$DATA(HLORNOD)#2:HLORNOD,1:"")
IF %T!%D
SET ^DIA(%F,Y,4.1)=%T_U_%D
+4 SET $PIECE(^(0),U,3,4)=Y_U_($PIECE(^DIA(%F,0),U,4)+1)
TIME SET %D=Y
SET %T=$$HTFM^DILIBF($HOROLOG)
+1 SET ^DIA(%F,"C",%T,Y)=""
SET ^DIA(%F,"D",DUZ,Y)=""
+2 QUIT
