- DIAU ;SFISC/XAK-AUDIT OPTIONS ; Apr 13, 2023@09:19:21
- ;;22.2;VA FileMan;**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.
- 0 S DIC="^DOPT(""DIAU"","
- I '$D(^DOPT("DIAU","B","MONITOR A USER")) D
- .S ^DOPT("DIAU",0)="AUDIT OPTION^1.01" K ^("B")
- .F X=1:1:6 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 Y=$O(^DIC(DIB(1))) S:'Y Y=DIB(1)+1 S DIB(1)=$O(^DD(Y),-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 ;;MONITOR A USER
- N DIAUSR,%DT,DHIT,DWHEN,DIC,DIAUIDEN
- S DIC=200,DIC(0)="AQEM",DIC("A")="Select a USER who has signed on to this system: ",DIC("S")="I $G(^(1.1))" D ^DIC K DIC Q:Y<0 S DIAUSR=+Y
- D R1^DICRW ;Creates a DIC("S") that screens out files user has no access to
- S DIC("S")=DIC("S")_" I $D(^DIA(+Y,""D"",DIAUSR))",DIC=1,DIC(0)="QAEI",DIC("A")="Select AUDITED File: "
- S Y=$G(^DISV(DUZ,"^DIC(")) I Y X DIC("S") I S DIC("B")=Y
- D ^DIC K DIC
- Q:$G(Y)'>0 S DIA=+Y,DIAUIDEN=$G(^DD(DIA,0,"ID","WRITE"))
- K ^UTILITY("DIAU",$J)
- S B=0,%DT="AEPT",%DT("A")="START WITH DATE: FIRST// " D ^%DT S DWHEN=" SINCE "_$$DATE^DIUTL(Y) I Y<1 Q:X]"" S Y=0,DWHEN=""
- S A=$O(^DIA(DIA,"C",Y-.0001)) Q:'A S B=$O(^(A,0))-.01
- F A=B:0 S A=$O(^DIA(DIA,"D",DIAUSR,A)) Q:'A S P=$G(^DIA(DIA,A,0)) I P D
- .I $D(^UTILITY("DIAU",$J,0,+P)) S $P(^(+P),U,2)=A Q
- .S ^UTILITY("DIAU",$J,0,+P)=A,DP=$$GET1^DIQ(DIA,+P,.01) S:DP]"" ^UTILITY("DIAU",$J,1,DP,+P)="" ;BY NAME
- WRITE S BY(0)="^UTILITY(""DIAU"","_$J_",1,",L(0)=2,FLDS=""
- S DHD="W ! D WUSRDHD^DIAU"
- S DIC=^DIC(DIA,0,"GL")
- S DIOEND="K ^UTILITY(""DIAU"","_$J_")",DHIT="D WUSR^DIAU(D0)"
- 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
- ;
- WUSRDHD ;CALLED BY DHD
- W $P(^DIC(DIA,0),U)," RECORDS ACCESSED BY ",$P(^VA(200,DIAUSR,0),U)," (DUZ=",DIAUSR,") ",DWHEN,?IOM-8,"Page ",DC,!
- W ?IOM-50,"EARLIEST ACCESS",?IOM-25,"LATEST ACCESS",!
- W $TR($J("",IOM)," ","-"),!
- Q
- ;
- WUSR(Y) ;CALLED BY DHIT
- N X,DIAU,DIC,DITAB
- W $$GET1^DIQ(DIA,Y,.01) ;NAME
- S DITAB=IOM-50 D:DIAUIDEN]""
- .;I IOM>131 W ?80 S $X=19
- .;E D N^DIO2 W ?19
- .S DIC=^DIC(DIA,0,"GL") I $G(@(DIC_"+Y,0)"))]"" X DIAUIDEN ;CALL ^DD(2,0,"ID","WRITE") WITH NAKED REFERENCE
- .I IOM<132 D N^DIO2
- S DIAU=^UTILITY("DIAU",$J,0,D0),X=+DIAU
- W ?DITAB D W ?DITAB+25 S X=$P(DIAU,U,2) D:X
- .N Y S Y=$P(^DIA(DIA,X,0),U,2) X ^DD("DD") W Y
- D N^DIO2
- 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) I $E(%)'=""C"""
- 52 S DIC("W")="N %,%A S %A=$G(^(""AUDIT"")),%=$P(^(0),U,2) W:% $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"") S:% %A=$G(^(""AUDIT"")) W "" "",%A"
- 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"),^("AX")
- I $G(^DD(DA(1),DDA,"AUDIT"))]"" S X=^("AUDIT") D ;p27 allow editing of AUDIT CONDITION
- . I X="n" K ^DD(DA(1),DDA,"AX") Q
- . K DIR S:$D(^DD(DA(1),DDA,"AX")) DIR("B")=^("AX")
- . S DIR(0)="0,1.2" D ^DIR I $D(DIRUT)!(X="@") K ^DD(DA(1),DDA,"AX") Q
- . S ^DD(DA(1),DDA,"AX")=X
- 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+1
- G STOP^DIO4
- ;
- ;
- 6 ;;SHOW PAST CHANGES TO DD'S
- N DIR,DIRB,%DT S DIRB=$$EZBLD^DIALOG(7065)
- S DIR(0)="FO^^S:X=DIRB X=1900 S %DT=""EP"" D ^%DT",DIR("A")="Show Data Dictionary changes since",DIR("B")=DIRB
- S DIR("?")="Enter a date. All audited changes to Data Dictionaries, starting with that date, will be shown."
- D ^DIR I Y>0 D DISP^DIAUTL(Y)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIAU 6880 printed Feb 19, 2025@00:11:14 Page 2
- DIAU ;SFISC/XAK-AUDIT OPTIONS ; Apr 13, 2023@09:19:21
- +1 ;;22.2;VA FileMan;**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.
- 0 SET DIC="^DOPT(""DIAU"","
- +1 IF '$DATA(^DOPT("DIAU","B","MONITOR A USER"))
- Begin DoDot:1
- +2 SET ^DOPT("DIAU",0)="AUDIT OPTION^1.01"
- KILL ^("B")
- +3 FOR X=1:1:6
- SET ^DOPT("DIAU",X,0)=$PIECE($TEXT(@X),";;",2)
- +4 SET DIK=DIC
- DO IXALL^DIK
- End DoDot:1
- 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 Y=$ORDER(^DIC(DIB(1)))
- if 'Y
- SET Y=DIB(1)+1
- SET DIB(1)=$ORDER(^DD(Y),-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 ;
- +10 ;
- 2 ;;MONITOR A USER
- +1 NEW DIAUSR,%DT,DHIT,DWHEN,DIC,DIAUIDEN
- +2 SET DIC=200
- SET DIC(0)="AQEM"
- SET DIC("A")="Select a USER who has signed on to this system: "
- SET DIC("S")="I $G(^(1.1))"
- DO ^DIC
- KILL DIC
- if Y<0
- QUIT
- SET DIAUSR=+Y
- +3 ;Creates a DIC("S") that screens out files user has no access to
- DO R1^DICRW
- +4 SET DIC("S")=DIC("S")_" I $D(^DIA(+Y,""D"",DIAUSR))"
- SET DIC=1
- SET DIC(0)="QAEI"
- SET DIC("A")="Select AUDITED File: "
- +5 SET Y=$GET(^DISV(DUZ,"^DIC("))
- IF Y
- XECUTE DIC("S")
- IF $TEST
- SET DIC("B")=Y
- +6 DO ^DIC
- KILL DIC
- +7 if $GET(Y)'>0
- QUIT
- SET DIA=+Y
- SET DIAUIDEN=$GET(^DD(DIA,0,"ID","WRITE"))
- +8 KILL ^UTILITY("DIAU",$JOB)
- +9 SET B=0
- SET %DT="AEPT"
- SET %DT("A")="START WITH DATE: FIRST// "
- DO ^%DT
- SET DWHEN=" SINCE "_$$DATE^DIUTL(Y)
- IF Y<1
- if X]""
- QUIT
- SET Y=0
- SET DWHEN=""
- +10 SET A=$ORDER(^DIA(DIA,"C",Y-.0001))
- if 'A
- QUIT
- SET B=$ORDER(^(A,0))-.01
- +11 FOR A=B:0
- SET A=$ORDER(^DIA(DIA,"D",DIAUSR,A))
- if 'A
- QUIT
- SET P=$GET(^DIA(DIA,A,0))
- IF P
- Begin DoDot:1
- +12 IF $DATA(^UTILITY("DIAU",$JOB,0,+P))
- SET $PIECE(^(+P),U,2)=A
- QUIT
- +13 ;BY NAME
- SET ^UTILITY("DIAU",$JOB,0,+P)=A
- SET DP=$$GET1^DIQ(DIA,+P,.01)
- if DP]""
- SET ^UTILITY("DIAU",$JOB,1,DP,+P)=""
- End DoDot:1
- WRITE SET BY(0)="^UTILITY(""DIAU"","_$JOB_",1,"
- SET L(0)=2
- SET FLDS=""
- +1 SET DHD="W ! D WUSRDHD^DIAU"
- +2 SET DIC=^DIC(DIA,0,"GL")
- +3 SET DIOEND="K ^UTILITY(""DIAU"","_$JOB_")"
- SET DHIT="D WUSR^DIAU(D0)"
- +4 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 ;
- WUSRDHD ;CALLED BY DHD
- +1 WRITE $PIECE(^DIC(DIA,0),U)," RECORDS ACCESSED BY ",$PIECE(^VA(200,DIAUSR,0),U)," (DUZ=",DIAUSR,") ",DWHEN,?IOM-8,"Page ",DC,!
- +2 WRITE ?IOM-50,"EARLIEST ACCESS",?IOM-25,"LATEST ACCESS",!
- +3 WRITE $TRANSLATE($JUSTIFY("",IOM)," ","-"),!
- +4 QUIT
- +5 ;
- WUSR(Y) ;CALLED BY DHIT
- +1 NEW X,DIAU,DIC,DITAB
- +2 ;NAME
- WRITE $$GET1^DIQ(DIA,Y,.01)
- +3 SET DITAB=IOM-50
- if DIAUIDEN]""
- Begin DoDot:1
- +4 ;I IOM>131 W ?80 S $X=19
- +5 ;E D N^DIO2 W ?19
- +6 ;CALL ^DD(2,0,"ID","WRITE") WITH NAKED REFERENCE
- SET DIC=^DIC(DIA,0,"GL")
- IF $GET(@(DIC_"+Y,0)"))]""
- XECUTE DIAUIDEN
- +7 IF IOM<132
- DO N^DIO2
- End DoDot:1
- +8 SET DIAU=^UTILITY("DIAU",$JOB,0,D0)
- SET X=+DIAU
- +9 WRITE ?DITAB
- Begin DoDot:1
- +10 NEW Y
- SET Y=$PIECE(^DIA(DIA,X,0),U,2)
- XECUTE ^DD("DD")
- WRITE Y
- End DoDot:1
- WRITE ?DITAB+25
- SET X=$PIECE(DIAU,U,2)
- if X
- Begin DoDot:1
- End DoDot:1
- +11 DO N^DIO2
- +12 QUIT
- +13 ;
- +14 ;
- 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 ;
- +8 ;
- 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 ;
- +9 ;
- 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(^(0),U,2) I $E(%)'=""C"""
- 52 SET DIC("W")="N %,%A S %A=$G(^(""AUDIT"")),%=$P(^(0),U,2) W:% $S($P(^DD(+%,.01,0),U,2)[""W"":"" (word-processing)"",1:"" (multiple)"") S:% %A=$G(^(""AUDIT"")) W "" "",%A"
- +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"),^("AX")
- +6 ;p27 allow editing of AUDIT CONDITION
- IF $GET(^DD(DA(1),DDA,"AUDIT"))]""
- SET X=^("AUDIT")
- Begin DoDot:1
- +7 IF X="n"
- KILL ^DD(DA(1),DDA,"AX")
- QUIT
- +8 KILL DIR
- if $DATA(^DD(DA(1),DDA,"AX"))
- SET DIR("B")=^("AX")
- +9 SET DIR(0)="0,1.2"
- DO ^DIR
- IF $DATA(DIRUT)!(X="@")
- KILL ^DD(DA(1),DDA,"AX")
- QUIT
- +10 SET ^DD(DA(1),DDA,"AX")=X
- End DoDot:1
- +11 WRITE !!
- GOTO 51
- +12 ;
- 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
- +1 GOTO STOP^DIO4
- +2 ;
- +3 ;
- 6 ;;SHOW PAST CHANGES TO DD'S
- +1 NEW DIR,DIRB,%DT
- SET DIRB=$$EZBLD^DIALOG(7065)
- +2 SET DIR(0)="FO^^S:X=DIRB X=1900 S %DT=""EP"" D ^%DT"
- SET DIR("A")="Show Data Dictionary changes since"
- SET DIR("B")=DIRB
- +3 SET DIR("?")="Enter a date. All audited changes to Data Dictionaries, starting with that date, will be shown."
- +4 DO ^DIR
- IF Y>0
- DO DISP^DIAUTL(Y)
- +5 QUIT