DIAU ;SFISC/XAK-AUDIT OPTIONS ;24JUNE2003
;;22.0;VA FileMan;**76,129**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
0 S DIC="^DOPT(""DIAU"","
G OPT:$D(^DOPT("DIAU",5)) S ^(0)="AUDIT OPTION^1.01" K ^("B")
F X=1:1:5 S ^DOPT("DIAU",X,0)=$P($T(@X),";;",2)
S DIK=DIC D IXALL^DIK
OPT ;
S DIC(0)="AEQIZ" D ^DIC G Q:Y<0 S DI=+Y D EN G 0
EN ;
D @DI W !!
Q K %,DIC,DIK,DI,DA,I,J,X,Y Q
;
1 ;;FIELDS BEING AUDITED
D L^DICRW1 Q:'$D(DIC) S (DUB,DIB,DFF)=+Y,BY(0)="^DD(DFF,""AUDIT"",",L(0)=1
S DIB(1)=$O(^DD($O(^DIC(DIB(1)))),-1) S:'DIB(1) DIB(1)=DIB
I $O(^DD(DIB,"AUDIT",""))="" F S DIB=$O(^DD(+DIB)) Q:'DIB!(DIB>DIB(1)) I $O(^DD(DIB,"AUDIT",""))]"" S (DUB,DFF)=DIB Q
I 'DIB!(DIB>DIB(1)) G Q2
S FLDS="W DFF;C1;L9;""FILE"",.001;L9,.01;L20,.25;L15,1.1",DISUPNO=1
S L=0,DHD="AUDITED FIELDS",DIS(0)="I $D(^DD(DFF,D0,""AUDIT"")),""n""'[^(""AUDIT"")"
S DIA=1,DIC="^DD(DFF,",DIOEND="G L^DIDC" D EN1^DIP
G Q2
;
2 ;;DATA DICTIONARIES BEING AUDITED
S DIC=1,BY=.001,FLDS=".001;L14;""FILE"",.01",L=0
S DIS(0)="I $D(^DD(D0,0,""DDA"")),^(""DDA"")[""Y"""
S DHD="DATA DICTIONARIES BEING AUDITED" D EN1^DIP
Q2 K DIA,A,B,DIJ,DP,P,BY,FLDS,DIS,DHD,DCC,L,DNP,DFF,DIB,DIJS,DIPQ,DIMS,DIPP,DUB,DIOEND Q
;
3 ;;PURGE DATA AUDITS
S DIC("S")="I $D(^DIA(+Y)),'$D(^DD(+Y,0,""AUDPURGEFORBID"")) S DIAC=""AUDIT"",DIFILE=+Y D ^DIAC I DIAC"
S DIA="" D AU^DICRW K DIC("S") G Q2:$D(DTOUT),Q2:Y<0,Q2:'$D(DIC)
S DDA="DATA" D ALL G Q2:$D(DIRUT)
I Y W !!,"..." K ^DIA(DIA) H 3 W "DELETED" G Q2
W ! S L="PURGE AUDIT RECORDS",DIOEND="D ENDKILL^DIAU",DISTOP=0
S FLDS="",DHD="PURGE OF AUDIT DATA: "_$O(^DD(DIA,0,"NM",0))_" FILE",DISUPNO=1
S DHIT="D KILLDIA^DIAU",DIACNT=0
D EN1^DIP K DISTOP,DHIT,DIK,DA,DIACNT G Q2
;
KILLDIA ;CALLED FROM DHIT
S X=$G(^DIA(DIA,D0,0)) K ^DIA(DIA,D0)
S Y=$P(X,U) I Y K ^DIA(DIA,"B",Y,D0)
S Y=$P(X,U,2) I Y K ^DIA(DIA,"C",Y,D0)
S Y=$P(X,U,4) K ^DIA(DIA,"D",+Y,D0)
S DIACNT=DIACNT+1 Q
;
ENDKILL ;CHECK DANGLERS
S $P(^(0),U,4)=$P($G(^DIA(DIA,0)),U,4)-DIACNT
W !!,"...",! W $$DANGLE(DIA)," POINTERS FIXED."
W !!,DIACNT," RECORDS PURGED."
Q
;
DANGLE(DIA) ;CLEAN DANGLERS
N A,B,D0,AA,C
S C=0
F AA=1,2,4 S A=$E("BC D",AA),B="" D
.F S B=$O(^DIA(DIA,A,B)) Q:B="" D
..F D0=0:0 S D0=$O(^DIA(DIA,A,B,D0)) Q:'D0 I $P($G(^DIA(DIA,D0,0)),U,AA)'=B K ^DIA(DIA,A,B,D0) S C=C+1
Q C
;
4 ;;PURGE DD AUDITS
S DIC("S")="I '$D(^DD(+Y,0,""DDAUDPURGEFORBID"")) S DIAC=""AUDIT"",DIFILE=+Y D ^DIAC I DIAC"
S DIA="DDA",DDA="DD" D A^DICRW G Q:$D(DTOUT)!(Y<0)!'$D(DIC)
D ALL G:$D(DIRUT) Q I Y S X=DIA D PR G Q
W ! S L="PURGE DD AUDIT RECORDS",DIOEND="G M^DIAU",DISTOP=0,DISUPNO=1
S FLDS="",DHD="PURGE OF DD AUDIT: "_$O(^DD(DIA,0,"NM",0))_" FILE"
S DHIT="S DIK=DCC,DA=D0,DIACNT=DIACNT+1 D ^DIK",DIACNT=0,DIC="^DDA(DDA,"
S DDA=DIA D EN1^DIP K DISTOP,DHIT,DIK,DA,DIACNT G Q2
;
5 ;;TURN DATA AUDIT ON/OFF
N J,DUOUT,DIRUT,DA,DDA,DIAU,DIA,C,D,%,DIC,X,Y,DIR
S (DDA,DIA)=0 D AU^DICRW I 'DIA Q
51 S DIC="^DD("_DIA_",",DIC(0)="QEANIZ",DA(1)=DIA
S DIC("S")="I 1 S %=$P(^(0),U,2) Q:'%&($E(%)'=""C"") I $E(%)'=""C"",$P(^DD(+%,.01,0),U,2)'[""W"""
52 S DIC("W")="W:$P(^(0),U,2) "" (multiple)"" W "" "",$G(^(""AUDIT""))"
D ^DIC I Y<0 K DIA G Q
I $P(Y(0),U,2) S DA(1)=+$P(Y(0),U,2),DIC="^DD("_DA(1)_"," G 52
K DIC,DIR S DDA=+Y S:$D(^("AUDIT")) DIR("B")=^("AUDIT")
S DIR(0)="0,1.1" D ^DIR I $D(DIRUT) Q:X'="@" S Y="n"
D TURNON^DIAUTL(DA(1),DDA,Y) I $D(DIRUT) K ^DD(DA(1),DDA,"AUDIT")
W !! G 51
;
ALL S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="DO YOU WANT TO PURGE ALL "_DDA_" AUDIT RECORDS"
S DIR("??")="^W !!?5,""Answer 'YES' to purge all the "_DDA_" audit records for this file, or"",!?5,""answer 'NO' to sort out the records to be purged."""
D ^DIR Q:$D(DIRUT) I Y S DIR("A")="ARE YOU SURE" D ^DIR
K DIR Q
;
PR ;
N DIA S DIA=X N X K ^DDA(DIA)
F X=0:0 S X=$O(^DD(DIA,"SB",X)) Q:X'>0 D PR
Q
M S DDA=$O(^DDA(DDA))
I DDA'>0!(DDA-1>DIA) W !!,DIACNT," RECORDS PURGED." G QM
S %=0,X=DDA D UP G P:%,M:'%
UP Q:'$D(^DD(X,0,"UP")) S X=^("UP") I X=DIA S %=1 Q
G UP
P K ^UTILITY($J,0) S %X="DIPP(",%Y="DPP(" D %XY^%RCR
S DPP=DIPP,L=0,DJ=DIJS,DPQ=DIPQ,M=DIMS,C=",",DIOSL=IOSL G ^DIO
Q
QM ;RETURN TO ^DIO4 FROM LINE TAG M
G STOP^DIO4
DIAU ;SFISC/XAK-AUDIT OPTIONS ;24JUNE2003
+1 ;;22.0;VA FileMan;**76,129**;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
0 SET DIC="^DOPT(""DIAU"","
+1 IF $DATA(^DOPT("DIAU",5))
GOTO OPT
SET ^(0)="AUDIT OPTION^1.01"
KILL ^("B")
+2 FOR X=1:1:5
SET ^DOPT("DIAU",X,0)=$PIECE($TEXT(@X),";;",2)
+3 SET DIK=DIC
DO IXALL^DIK
OPT ;
+1 SET DIC(0)="AEQIZ"
DO ^DIC
IF Y<0
GOTO Q
SET DI=+Y
DO EN
GOTO 0
EN ;
+1 DO @DI
WRITE !!
Q KILL %,DIC,DIK,DI,DA,I,J,X,Y
QUIT
+1 ;
1 ;;FIELDS BEING AUDITED
+1 DO L^DICRW1
IF '$DATA(DIC)
QUIT
SET (DUB,DIB,DFF)=+Y
SET BY(0)="^DD(DFF,""AUDIT"","
SET L(0)=1
+2 SET DIB(1)=$ORDER(^DD($ORDER(^DIC(DIB(1)))),-1)
IF 'DIB(1)
SET DIB(1)=DIB
+3 IF $ORDER(^DD(DIB,"AUDIT",""))=""
FOR
SET DIB=$ORDER(^DD(+DIB))
IF 'DIB!(DIB>DIB(1))
QUIT
IF $ORDER(^DD(DIB,"AUDIT",""))]""
SET (DUB,DFF)=DIB
QUIT
+4 IF 'DIB!(DIB>DIB(1))
GOTO Q2
+5 SET FLDS="W DFF;C1;L9;""FILE"",.001;L9,.01;L20,.25;L15,1.1"
SET DISUPNO=1
+6 SET L=0
SET DHD="AUDITED FIELDS"
SET DIS(0)="I $D(^DD(DFF,D0,""AUDIT"")),""n""'[^(""AUDIT"")"
+7 SET DIA=1
SET DIC="^DD(DFF,"
SET DIOEND="G L^DIDC"
DO EN1^DIP
+8 GOTO Q2
+9 ;
2 ;;DATA DICTIONARIES BEING AUDITED
+1 SET DIC=1
SET BY=.001
SET FLDS=".001;L14;""FILE"",.01"
SET L=0
+2 SET DIS(0)="I $D(^DD(D0,0,""DDA"")),^(""DDA"")[""Y"""
+3 SET DHD="DATA DICTIONARIES BEING AUDITED"
DO EN1^DIP
Q2 KILL DIA,A,B,DIJ,DP,P,BY,FLDS,DIS,DHD,DCC,L,DNP,DFF,DIB,DIJS,DIPQ,DIMS,DIPP,DUB,DIOEND
QUIT
+1 ;
3 ;;PURGE DATA AUDITS
+1 SET DIC("S")="I $D(^DIA(+Y)),'$D(^DD(+Y,0,""AUDPURGEFORBID"")) S DIAC=""AUDIT"",DIFILE=+Y D ^DIAC I DIAC"
+2 SET DIA=""
DO AU^DICRW
KILL DIC("S")
IF $DATA(DTOUT)
GOTO Q2
IF Y<0
GOTO Q2
IF '$DATA(DIC)
GOTO Q2
+3 SET DDA="DATA"
DO ALL
IF $DATA(DIRUT)
GOTO Q2
+4 IF Y
WRITE !!,"..."
KILL ^DIA(DIA)
HANG 3
WRITE "DELETED"
GOTO Q2
+5 WRITE !
SET L="PURGE AUDIT RECORDS"
SET DIOEND="D ENDKILL^DIAU"
SET DISTOP=0
+6 SET FLDS=""
SET DHD="PURGE OF AUDIT DATA: "_$ORDER(^DD(DIA,0,"NM",0))_" FILE"
SET DISUPNO=1
+7 SET DHIT="D KILLDIA^DIAU"
SET DIACNT=0
+8 DO EN1^DIP
KILL DISTOP,DHIT,DIK,DA,DIACNT
GOTO Q2
+9 ;
KILLDIA ;CALLED FROM DHIT
+1 SET X=$GET(^DIA(DIA,D0,0))
KILL ^DIA(DIA,D0)
+2 SET Y=$PIECE(X,U)
IF Y
KILL ^DIA(DIA,"B",Y,D0)
+3 SET Y=$PIECE(X,U,2)
IF Y
KILL ^DIA(DIA,"C",Y,D0)
+4 SET Y=$PIECE(X,U,4)
KILL ^DIA(DIA,"D",+Y,D0)
+5 SET DIACNT=DIACNT+1
QUIT
+6 ;
ENDKILL ;CHECK DANGLERS
+1 SET $PIECE(^(0),U,4)=$PIECE($GET(^DIA(DIA,0)),U,4)-DIACNT
+2 WRITE !!,"...",!
WRITE $$DANGLE(DIA)," POINTERS FIXED."
+3 WRITE !!,DIACNT," RECORDS PURGED."
+4 QUIT
+5 ;
DANGLE(DIA) ;CLEAN DANGLERS
+1 NEW A,B,D0,AA,C
+2 SET C=0
+3 FOR AA=1,2,4
SET A=$EXTRACT("BC D",AA)
SET B=""
Begin DoDot:1
+4 FOR
SET B=$ORDER(^DIA(DIA,A,B))
IF B=""
QUIT
Begin DoDot:2
+5 FOR D0=0:0
SET D0=$ORDER(^DIA(DIA,A,B,D0))
IF 'D0
QUIT
IF $PIECE($GET(^DIA(DIA,D0,0)),U,AA)'=B
KILL ^DIA(DIA,A,B,D0)
SET C=C+1
End DoDot:2
End DoDot:1
+6 QUIT C
+7 ;
4 ;;PURGE DD AUDITS
+1 SET DIC("S")="I '$D(^DD(+Y,0,""DDAUDPURGEFORBID"")) S DIAC=""AUDIT"",DIFILE=+Y D ^DIAC I DIAC"
+2 SET DIA="DDA"
SET DDA="DD"
DO A^DICRW
IF $DATA(DTOUT)!(Y<0)!'$DATA(DIC)
GOTO Q
+3 DO ALL
IF $DATA(DIRUT)
GOTO Q
IF Y
SET X=DIA
DO PR
GOTO Q
+4 WRITE !
SET L="PURGE DD AUDIT RECORDS"
SET DIOEND="G M^DIAU"
SET DISTOP=0
SET DISUPNO=1
+5 SET FLDS=""
SET DHD="PURGE OF DD AUDIT: "_$ORDER(^DD(DIA,0,"NM",0))_" FILE"
+6 SET DHIT="S DIK=DCC,DA=D0,DIACNT=DIACNT+1 D ^DIK"
SET DIACNT=0
SET DIC="^DDA(DDA,"
+7 SET DDA=DIA
DO EN1^DIP
KILL DISTOP,DHIT,DIK,DA,DIACNT
GOTO Q2
+8 ;
5 ;;TURN DATA AUDIT ON/OFF
+1 NEW J,DUOUT,DIRUT,DA,DDA,DIAU,DIA,C,D,%,DIC,X,Y,DIR
+2 SET (DDA,DIA)=0
DO AU^DICRW
IF 'DIA
QUIT
51 SET DIC="^DD("_DIA_","
SET DIC(0)="QEANIZ"
SET DA(1)=DIA
+1 SET DIC("S")="I 1 S %=$P">P(^(0),U,2) Q:'%&($E(%)'=""C"") I $E(%)'=""C"",$P">P(^DD(+%,.01,0),U,2)'[""W"""
52 SET DIC("W")="W:$P(^(0),U,2) "" (multiple)"" W "" "",$G(^(""AUDIT""))"
+1 DO ^DIC
IF Y<0
KILL DIA
GOTO Q
+2 IF $PIECE(Y(0),U,2)
SET DA(1)=+$PIECE(Y(0),U,2)
SET DIC="^DD("_DA(1)_","
GOTO 52
+3 KILL DIC,DIR
SET DDA=+Y
IF $DATA(^("AUDIT"))
SET DIR("B")=^("AUDIT")
+4 SET DIR(0)="0,1.1"
DO ^DIR
IF $DATA(DIRUT)
IF X'="@"
QUIT
SET Y="n"
+5 DO TURNON^DIAUTL(DA(1),DDA,Y)
IF $DATA(DIRUT)
KILL ^DD(DA(1),DDA,"AUDIT")
+6 WRITE !!
GOTO 51
+7 ;
ALL SET DIR(0)="Y"
SET DIR("B")="NO"
+1 SET DIR("A")="DO YOU WANT TO PURGE ALL "_DDA_" AUDIT RECORDS"
+2 SET DIR("??")="^W !!?5,""Answer 'YES' to purge all the "_DDA_" audit records for this file, or"",!?5,""answer 'NO' to sort out the records to be purged."""
+3 DO ^DIR
IF $DATA(DIRUT)
QUIT
IF Y
SET DIR("A")="ARE YOU SURE"
DO ^DIR
+4 KILL DIR
QUIT
+5 ;
PR ;
+1 NEW DIA
SET DIA=X
NEW X
KILL ^DDA(DIA)
+2 FOR X=0:0
SET X=$ORDER(^DD(DIA,"SB",X))
IF X'>0
QUIT
DO PR
+3 QUIT
M SET DDA=$ORDER(^DDA(DDA))
+1 IF DDA'>0!(DDA-1>DIA)
WRITE !!,DIACNT," RECORDS PURGED."
GOTO QM
+2 SET %=0
SET X=DDA
DO UP
IF %
GOTO P
IF '%
GOTO M
UP IF '$DATA(^DD(X,0,"UP"))
QUIT
SET X=^("UP")
IF X=DIA
SET %=1
QUIT
+1 GOTO UP
P KILL ^UTILITY($JOB,0)
SET %X="DIPP("
SET %Y="DPP("
DO %XY^%RCR
+1 SET DPP=DIPP
SET L=0
SET DJ=DIJS
SET DPQ=DIPQ
SET M=DIMS
SET C=","
SET DIOSL=IOSL
GOTO ^DIO
+2 QUIT
QM ;RETURN TO ^DIO4 FROM LINE TAG M
+1 GOTO STOP^DIO4
