| 1 | DIAU ;SFISC/XAK-AUDIT OPTIONS ;24JUNE2003
|
|---|
| 2 | ;;22.0;VA FileMan;**76,129**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | 0 S DIC="^DOPT(""DIAU"","
|
|---|
| 5 | G OPT:$D(^DOPT("DIAU",5)) S ^(0)="AUDIT OPTION^1.01" K ^("B")
|
|---|
| 6 | F X=1:1:5 S ^DOPT("DIAU",X,0)=$P($T(@X),";;",2)
|
|---|
| 7 | S DIK=DIC D IXALL^DIK
|
|---|
| 8 | OPT ;
|
|---|
| 9 | S DIC(0)="AEQIZ" D ^DIC G Q:Y<0 S DI=+Y D EN G 0
|
|---|
| 10 | EN ;
|
|---|
| 11 | D @DI W !!
|
|---|
| 12 | Q K %,DIC,DIK,DI,DA,I,J,X,Y Q
|
|---|
| 13 | ;
|
|---|
| 14 | 1 ;;FIELDS BEING AUDITED
|
|---|
| 15 | D L^DICRW1 Q:'$D(DIC) S (DUB,DIB,DFF)=+Y,BY(0)="^DD(DFF,""AUDIT"",",L(0)=1
|
|---|
| 16 | S DIB(1)=$O(^DD($O(^DIC(DIB(1)))),-1) S:'DIB(1) DIB(1)=DIB
|
|---|
| 17 | 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
|
|---|
| 18 | I 'DIB!(DIB>DIB(1)) G Q2
|
|---|
| 19 | S FLDS="W DFF;C1;L9;""FILE"",.001;L9,.01;L20,.25;L15,1.1",DISUPNO=1
|
|---|
| 20 | S L=0,DHD="AUDITED FIELDS",DIS(0)="I $D(^DD(DFF,D0,""AUDIT"")),""n""'[^(""AUDIT"")"
|
|---|
| 21 | S DIA=1,DIC="^DD(DFF,",DIOEND="G L^DIDC" D EN1^DIP
|
|---|
| 22 | G Q2
|
|---|
| 23 | ;
|
|---|
| 24 | 2 ;;DATA DICTIONARIES BEING AUDITED
|
|---|
| 25 | S DIC=1,BY=.001,FLDS=".001;L14;""FILE"",.01",L=0
|
|---|
| 26 | S DIS(0)="I $D(^DD(D0,0,""DDA"")),^(""DDA"")[""Y"""
|
|---|
| 27 | S DHD="DATA DICTIONARIES BEING AUDITED" D EN1^DIP
|
|---|
| 28 | Q2 K DIA,A,B,DIJ,DP,P,BY,FLDS,DIS,DHD,DCC,L,DNP,DFF,DIB,DIJS,DIPQ,DIMS,DIPP,DUB,DIOEND Q
|
|---|
| 29 | ;
|
|---|
| 30 | 3 ;;PURGE DATA AUDITS
|
|---|
| 31 | S DIC("S")="I $D(^DIA(+Y)),'$D(^DD(+Y,0,""AUDPURGEFORBID"")) S DIAC=""AUDIT"",DIFILE=+Y D ^DIAC I DIAC"
|
|---|
| 32 | S DIA="" D AU^DICRW K DIC("S") G Q2:$D(DTOUT),Q2:Y<0,Q2:'$D(DIC)
|
|---|
| 33 | S DDA="DATA" D ALL G Q2:$D(DIRUT)
|
|---|
| 34 | I Y W !!,"..." K ^DIA(DIA) H 3 W "DELETED" G Q2
|
|---|
| 35 | W ! S L="PURGE AUDIT RECORDS",DIOEND="D ENDKILL^DIAU",DISTOP=0
|
|---|
| 36 | S FLDS="",DHD="PURGE OF AUDIT DATA: "_$O(^DD(DIA,0,"NM",0))_" FILE",DISUPNO=1
|
|---|
| 37 | S DHIT="D KILLDIA^DIAU",DIACNT=0
|
|---|
| 38 | D EN1^DIP K DISTOP,DHIT,DIK,DA,DIACNT G Q2
|
|---|
| 39 | ;
|
|---|
| 40 | KILLDIA ;CALLED FROM DHIT
|
|---|
| 41 | S X=$G(^DIA(DIA,D0,0)) K ^DIA(DIA,D0)
|
|---|
| 42 | S Y=$P(X,U) I Y K ^DIA(DIA,"B",Y,D0)
|
|---|
| 43 | S Y=$P(X,U,2) I Y K ^DIA(DIA,"C",Y,D0)
|
|---|
| 44 | S Y=$P(X,U,4) K ^DIA(DIA,"D",+Y,D0)
|
|---|
| 45 | S DIACNT=DIACNT+1 Q
|
|---|
| 46 | ;
|
|---|
| 47 | ENDKILL ;CHECK DANGLERS
|
|---|
| 48 | S $P(^(0),U,4)=$P($G(^DIA(DIA,0)),U,4)-DIACNT
|
|---|
| 49 | W !!,"...",! W $$DANGLE(DIA)," POINTERS FIXED."
|
|---|
| 50 | W !!,DIACNT," RECORDS PURGED."
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | DANGLE(DIA) ;CLEAN DANGLERS
|
|---|
| 54 | N A,B,D0,AA,C
|
|---|
| 55 | S C=0
|
|---|
| 56 | F AA=1,2,4 S A=$E("BC D",AA),B="" D
|
|---|
| 57 | .F S B=$O(^DIA(DIA,A,B)) Q:B="" D
|
|---|
| 58 | ..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
|
|---|
| 59 | Q C
|
|---|
| 60 | ;
|
|---|
| 61 | 4 ;;PURGE DD AUDITS
|
|---|
| 62 | S DIC("S")="I '$D(^DD(+Y,0,""DDAUDPURGEFORBID"")) S DIAC=""AUDIT"",DIFILE=+Y D ^DIAC I DIAC"
|
|---|
| 63 | S DIA="DDA",DDA="DD" D A^DICRW G Q:$D(DTOUT)!(Y<0)!'$D(DIC)
|
|---|
| 64 | D ALL G:$D(DIRUT) Q I Y S X=DIA D PR G Q
|
|---|
| 65 | W ! S L="PURGE DD AUDIT RECORDS",DIOEND="G M^DIAU",DISTOP=0,DISUPNO=1
|
|---|
| 66 | S FLDS="",DHD="PURGE OF DD AUDIT: "_$O(^DD(DIA,0,"NM",0))_" FILE"
|
|---|
| 67 | S DHIT="S DIK=DCC,DA=D0,DIACNT=DIACNT+1 D ^DIK",DIACNT=0,DIC="^DDA(DDA,"
|
|---|
| 68 | S DDA=DIA D EN1^DIP K DISTOP,DHIT,DIK,DA,DIACNT G Q2
|
|---|
| 69 | ;
|
|---|
| 70 | 5 ;;TURN DATA AUDIT ON/OFF
|
|---|
| 71 | N J,DUOUT,DIRUT,DA,DDA,DIAU,DIA,C,D,%,DIC,X,Y,DIR
|
|---|
| 72 | S (DDA,DIA)=0 D AU^DICRW I 'DIA Q
|
|---|
| 73 | 51 S DIC="^DD("_DIA_",",DIC(0)="QEANIZ",DA(1)=DIA
|
|---|
| 74 | S DIC("S")="I 1 S %=$P(^(0),U,2) Q:'%&($E(%)'=""C"") I $E(%)'=""C"",$P(^DD(+%,.01,0),U,2)'[""W"""
|
|---|
| 75 | 52 S DIC("W")="W:$P(^(0),U,2) "" (multiple)"" W "" "",$G(^(""AUDIT""))"
|
|---|
| 76 | D ^DIC I Y<0 K DIA G Q
|
|---|
| 77 | I $P(Y(0),U,2) S DA(1)=+$P(Y(0),U,2),DIC="^DD("_DA(1)_"," G 52
|
|---|
| 78 | K DIC,DIR S DDA=+Y S:$D(^("AUDIT")) DIR("B")=^("AUDIT")
|
|---|
| 79 | S DIR(0)="0,1.1" D ^DIR I $D(DIRUT) Q:X'="@" S Y="n"
|
|---|
| 80 | D TURNON^DIAUTL(DA(1),DDA,Y) I $D(DIRUT) K ^DD(DA(1),DDA,"AUDIT")
|
|---|
| 81 | W !! G 51
|
|---|
| 82 | ;
|
|---|
| 83 | ALL S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 84 | S DIR("A")="DO YOU WANT TO PURGE ALL "_DDA_" AUDIT RECORDS"
|
|---|
| 85 | 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."""
|
|---|
| 86 | D ^DIR Q:$D(DIRUT) I Y S DIR("A")="ARE YOU SURE" D ^DIR
|
|---|
| 87 | K DIR Q
|
|---|
| 88 | ;
|
|---|
| 89 | PR ;
|
|---|
| 90 | N DIA S DIA=X N X K ^DDA(DIA)
|
|---|
| 91 | F X=0:0 S X=$O(^DD(DIA,"SB",X)) Q:X'>0 D PR
|
|---|
| 92 | Q
|
|---|
| 93 | M S DDA=$O(^DDA(DDA))
|
|---|
| 94 | I DDA'>0!(DDA-1>DIA) W !!,DIACNT," RECORDS PURGED." G QM
|
|---|
| 95 | S %=0,X=DDA D UP G P:%,M:'%
|
|---|
| 96 | UP Q:'$D(^DD(X,0,"UP")) S X=^("UP") I X=DIA S %=1 Q
|
|---|
| 97 | G UP
|
|---|
| 98 | P K ^UTILITY($J,0) S %X="DIPP(",%Y="DPP(" D %XY^%RCR
|
|---|
| 99 | S DPP=DIPP,L=0,DJ=DIJS,DPQ=DIPQ,M=DIMS,C=",",DIOSL=IOSL G ^DIO
|
|---|
| 100 | Q
|
|---|
| 101 | QM ;RETURN TO ^DIO4 FROM LINE TAG M
|
|---|
| 102 | G STOP^DIO4
|
|---|
