- DIET ;SFISC/XAK-DISPLAY INPUT TEMPLATE ALSO DOES AUDITING! ;22FEB2011
- ;;22.0;VA FileMan;**69,49,104,129,147**;Mar 30, 1999;Build 5
- ;
- 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 ; 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)) S:%="" %=-1 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 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
- ;
- 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
- D:'$G(DT) DT^DICRW
- 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
- DIET ;SFISC/XAK-DISPLAY INPUT TEMPLATE ALSO DOES AUDITING! ;22FEB2011
- +1 ;;22.0;VA FileMan;**69,49,104,129,147**;Mar 30, 1999;Build 5
- +2 ;
- +3 NEW DICMX
- +4 IF '$DATA(^DIE(D0,0))
- GOTO EXIT
- +5 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 ; 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 %=""
- SET %=-1
- 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
- DO Y^DIQ
- +5 SET ^DIA(%F,"B",DIEDA_DA,%D)=""
- SET X=DIEX
- IF $DATA(DPS)
- SET DP(1)=DPS
- +6 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)
- +1 QUIT
- +2 ;
- 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(DT)
- DO DT^DICRW
- +3 IF '%F!'REF
- QUIT
- SET %F=+%F
- SET (REF,X)=+REF
- IF '$DATA(^DIC(%F))
- QUIT
- +4 ;COMES BACK WITH %T AND Y--THE AUDIT REF
- DO ADD
- +5 SET ^DIA(%F,Y,0)=REF_U_%T_U_.01_U_DUZ_U_U_"i"
- +6 SET ^DIA(%F,"B",REF,Y)=""
- +7 QUIT
- +8 ;
- 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
