ACRFAUD ;IHS/OIRM/DSD/AEF - PRINT ARMS AUDITS [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;
DESC ;----- ROUTINE DESCRIPTION
;;
;; This option prints a listing of audits for the specified file
;; during the specified date range. The list includes the audit
;; number, date/time recorded, user, file entry number, file entry
;; name, field number, field name, old value, and new value.
;; FileMan Auditing must be active to generate audit entries for
;; this list.
;;
;;$$END
;
EN ;EP -- MAIN ENTRY POINT
;
N ACRDATES,ACRFILE,ZTSAVE
D ^XBKVAR
D HOME^%ZIS
;
D TXT
;
D FILE(.ACRFILE)
Q:ACRFILE']""
;
D DATES(.ACRDATES)
Q:ACRDATES']""
;
S ZTSAVE("ACRDATES")=""
S ZTSAVE("ACRFILE")=""
D QUE^ACRFUTL("DQ^ACRFAUD",.ZTSAVE,"ARMS AUDIT REPORT")
;
Q
DQ ;EP -- QUEUED JOB ENTRY POINT
;
N ACRPAGE
D HDR(ACRDATES,ACRFILE)
D LOOP(ACRDATES,ACRFILE)
D ^%ZISC
Q
LOOP(ACRDATES,ACRFILE) ;
;----- LOOP THROUGH THE FILE
;
N ACRBEG,ACRCNT,ACRD0,ACRDATE,ACREND,ACRMSG,ACROUT,DIA,DIR,X,Y
S DIA=+$P(ACRFILE,U)
S ACRMSG="NO DATA FOUND"
S ACRBEG=$P(ACRDATES,U)
S ACREND=$P(ACRDATES,U,2)_".999999"
S ACRDATE=ACRBEG-1_".999999"
F S ACRDATE=$O(^DIA(DIA,"C",ACRDATE)) Q:'ACRDATE Q:ACRDATE>ACREND D Q:$G(ACROUT)
. S ACRD0=0
. F S ACRD0=$O(^DIA(DIA,"C",ACRDATE,ACRD0)) Q:'ACRD0 D Q:$G(ACROUT)
. . D PRT(ACRD0,ACRDATES,ACRFILE,.ACROUT)
. . S ACRMSG=""
Q:$G(ACROUT)
W !?5,ACRMSG
W !
I $E($G(IOST))="C" S DIR(0)="E" D ^DIR
Q
PRT(ACRD0,ACRDATES,ACRFILE,ACROUT) ;
;----- PRINT THE DATA
;
N DIA,ACRDATA,ACRDATE,ACRENT,ACRENTN,ACRFLD,ACRFLDN,ACRNEW,ACROLD,ACRUSER,X,Y
S ACRCNT=$G(ACRCNT)+1
I $E($G(IOST))="C",ACRCNT>2 D
. D HDR(ACRDATES,ACRFILE,.ACROUT)
. S ACRCNT=1
I $E($G(IOST))="P",ACRCNT>6 D
. D HDR(ACRDATES,ACRFILE,.ACROUT)
. S ACRCNT=1
Q:$G(ACROUT)
S DIA=+$P(ACRFILE,U)
S ACRDATA=^DIA(DIA,ACRD0,0)
S ACRENT=$P(ACRDATA,U)
S ACRENTN=$$ENTNAM(DIA,ACRD0)
S Y=$P(ACRDATA,U,2)
X ^DD("DD")
S ACRDATE=Y
S ACRFLD=$P(ACRDATA,U,3)
S ACRFLDN=$$FLDNAM(DIA,ACRD0)
S ACRUSER=$P(ACRDATA,U,4)
;I ACRUSER S ACRUSER=$P(^VA(200,ACRUSER,0),U) ;ACR*2.1*19.02 IM16848
I ACRUSER S ACRUSER=$$NAME2^ACRFUTL1(ACRUSER) ;ACR*2.1*19.02 IM16848
S ACROLD=$$OLD(DIA,ACRD0)
S ACRNEW=$$NEW(DIA,ACRD0)
;
W !!
W "AUDIT #: "
W ACRD0
W ?40,"DATE/TIME RECORDED: "
W ACRDATE
W !
W "USER: "
W ACRUSER
W !
W "FILE ENTRY #: "
W ACRENT
W ?40,"FILE ENTRY NAME: "
W ACRENTN
W !
W "FIELD #: "
W ACRFLD
W ?40,"FIELD NAME: "
W ACRFLDN
W !
W "OLD VALUE: "
W ACROLD
W !
W "NEW VALUE: "
W ACRNEW
Q
HDR(ACRDATES,ACRFILE,ACROUT) ;
;
N DIR,I,X,Y
I $E($G(IOST))="C",$G(ACRPAGE) D Q:$G(ACROUT)
. S DIR(0)="E"
. D ^DIR
. I 'Y S ACROUT=1
S ACRPAGE=$G(ACRPAGE)+1
W @IOF
W !,"AUDIT LISTING OF "_$P(ACRFILE,U,2)_" FILE"
W ?IOM-20,$$NOW^ACRFUTL
S Y=$P(ACRDATES,U)
X ^DD("DD")
W !,"FROM "_Y
S Y=$P(ACRDATES,U,2)
X ^DD("DD")
W " TO "_Y
W ?IOM-20,"PAGE: ",ACRPAGE
W !
F I=1:1:IOM W "-"
W !
Q
FILE(ACRFILE) ;
;----- ASK WHICH FILE
;
N DIC,DTOUT,DUOUT,X,Y
S ACRFILE=""
S DIC="^DIC("
S DIC(0)="AEMQ"
D ^DIC
Q:$D(DTOUT)!($D(DUOUT))
Q:+Y'>0
S ACRFILE=Y
Q
DATES(ACRDATES) ;
;----- ASK DATE RANGE
;
DLOOP ;----- DATE LOOP
;
N ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
S ACRDATES=""
W !
S DIR(0)="DO^::E"
S DIR("A")="Begin with AUDIT DATE"
S DIR("?")="The first date in the audit date range"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S ACRBEG=Y
S DIR("A")="End with AUDIT DATE"
S DIR("?")="The last date in the audit date range"
D ^DIR
Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
Q:Y=""
S ACREND=Y
I ACREND<ACRBEG D G DLOOP
. W *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
S ACRDATES=ACRBEG_U_ACREND
Q
ENTNAM(DIA,D0) ;
;----- EXTRINSIC FUNCTION - GET EXTERNAL FILE ENTRY NAME
;
; INPUT:
; DIA = FILE NUMBER
; D0 = INTERNAL NUMBER OF AUDIT ENTRY
;
; RETURNS EXTERNAL ENTRY NAME
;
N %,C,X,Y
Q:'$D(^DIA(DIA,D0))
S %=^DIC(DIA,0,"GL")
S X=^DIA(DIA,D0,0)
S X=$S($D(@(%_+X_",0)")):$P(^(0),U),1:"")
S C=$S($D(^DD(DIA,.01,0)):$P(^(0),U,2),1:"")
S Y=X
D:Y]"" Y^DIQ:C]""
S X=Y
Q X
;
FLDNAM(DIA,D0) ;
;----- EXTRINSIC FUNCTION - GET FIELD NAME
;
; INPUT:
; DIA = FILE NUMBER
; D0 = INTERNAL NUMBER OF AUDIT ENTRY
;
; RETURNS EXTERNAL FIELD NAME
;
N X,Y
S Y(1.1,1.1)=$S($D(^DIA(DIA,D0,0)):$P(^(0),U,3),1:"")
X ^DD(1.1,1.1,9.2)
K Y(1.1)
S X=$E(X,1,$L(X)-1)
Q X
;
OLD(DIA,D0) ;
;----- EXTRINSIC FUNCTION - GET OLD VALUE
;
; INPUT:
; DIA = FILE NUMBER
; D0 = INTERNAL NUMBER OF AUDIT ENTRY
;
; RETURNS OLD VALUE OF AUDIT FIELD
;
N X
S X=$S($D(^DIA(DIA,D0,2)):^(2),1:"<no previous value>")
Q X
;
NEW(DIA,D0) ;
;----- EXTRINSIC FUNCTION - GET NEW VALUE
;
; INPUT:
; DIA = FILE NUMBER
; D0 = INTERNAL NUMBER OF AUDIT ENTRY
;
; RETURNS NEW VALUE OF AUDIT FIELD
;
N X
S X=$S($D(^DIA(DIA,D0,3)):^(3),1:"<deleted>")
Q X
;
TXT ;----- PRINT OPTION DESCRIPTION
;
N I,X
F I=1:1 S X=$P($T(DESC+I),";",3) Q:X["$$END" W !,X
Q
ONE ;EP -- DISPLAY AUDIT TRAIL FOR ONE ENTRY
;
N ACRFILE,DA,DIC,X,Y,ZTSAVE
;
D FILE(.ACRFILE)
Q:ACRFILE']""
S DIC=^DIC(+ACRFILE,0,"GL")
;
D ENTRY(DIC,.Y)
Q:+Y'>0
S DA=+Y
;
S ZTSAVE("DIC")=""
S ZTSAVE("DA")=""
S ZTSAVE("ACRFILE")=""
D QUE^ACRFUTL("DQ1^ACRFAUD",.ZTSAVE,"ARMS AUDIT REPORT")
Q
DQ1 ;EP -- QUEUED REPORT STARTS HERE
;
N ACRPAGE
D HDR1(ACRFILE,DA,.ACROUT)
D DIQ(DIC,DA)
D ^%ZISC
Q
ENTRY(DIC,Y) ;
;----- LOOK UP FILE ENTRY
;
S DIC(0)="AEMQ"
D ^DIC
Q
DIQ(DIC,DA) ;
;----- CALL EN^DIQ TO DISPLAY THE ENTRY
;
S DIQ(0)="ACR"
D EN^DIQ
Q
HDR1(ACRFILE,DA,ACROUT) ;
;----- PRINT HEADER FOR ONE ENTRY AUDIT REPORT
;
N ACRENT,DIR,I,X,Y
I $E($G(IOST))="C",$G(ACRPAGE) D Q:$G(ACROUT)
. S DIR(0)="E"
. D ^DIR
. I 'Y S ACROUT=1
S ACRPAGE=$G(ACRPAGE)+1
W @IOF
W !,"AUDIT LISTING OF ",$P(ACRFILE,U,2)," FILE ENTRY "
W ?IOM-20,$$NOW^ACRFUTL
W !?IOM-20,"PAGE: ",ACRPAGE
W !
F I=1:1:IOM W "-"
W !
Q
ACRFAUD ;IHS/OIRM/DSD/AEF - PRINT ARMS AUDITS [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;
DESC ;----- ROUTINE DESCRIPTION
+1 ;;
+2 ;; This option prints a listing of audits for the specified file
+3 ;; during the specified date range. The list includes the audit
+4 ;; number, date/time recorded, user, file entry number, file entry
+5 ;; name, field number, field name, old value, and new value.
+6 ;; FileMan Auditing must be active to generate audit entries for
+7 ;; this list.
+8 ;;
+9 ;;$$END
+10 ;
EN ;EP -- MAIN ENTRY POINT
+1 ;
+2 NEW ACRDATES,ACRFILE,ZTSAVE
+3 DO ^XBKVAR
+4 DO HOME^%ZIS
+5 ;
+6 DO TXT
+7 ;
+8 DO FILE(.ACRFILE)
+9 IF ACRFILE']""
QUIT
+10 ;
+11 DO DATES(.ACRDATES)
+12 IF ACRDATES']""
QUIT
+13 ;
+14 SET ZTSAVE("ACRDATES")=""
+15 SET ZTSAVE("ACRFILE")=""
+16 DO QUE^ACRFUTL("DQ^ACRFAUD",.ZTSAVE,"ARMS AUDIT REPORT")
+17 ;
+18 QUIT
DQ ;EP -- QUEUED JOB ENTRY POINT
+1 ;
+2 NEW ACRPAGE
+3 DO HDR(ACRDATES,ACRFILE)
+4 DO LOOP(ACRDATES,ACRFILE)
+5 DO ^%ZISC
+6 QUIT
LOOP(ACRDATES,ACRFILE) ;
+1 ;----- LOOP THROUGH THE FILE
+2 ;
+3 NEW ACRBEG,ACRCNT,ACRD0,ACRDATE,ACREND,ACRMSG,ACROUT,DIA,DIR,X,Y
+4 SET DIA=+$PIECE(ACRFILE,U)
+5 SET ACRMSG="NO DATA FOUND"
+6 SET ACRBEG=$PIECE(ACRDATES,U)
+7 SET ACREND=$PIECE(ACRDATES,U,2)_".999999"
+8 SET ACRDATE=ACRBEG-1_".999999"
+9 FOR
SET ACRDATE=$ORDER(^DIA(DIA,"C",ACRDATE))
IF 'ACRDATE
QUIT
IF ACRDATE>ACREND
QUIT
Begin DoDot:1
+10 SET ACRD0=0
+11 FOR
SET ACRD0=$ORDER(^DIA(DIA,"C",ACRDATE,ACRD0))
IF 'ACRD0
QUIT
Begin DoDot:2
+12 DO PRT(ACRD0,ACRDATES,ACRFILE,.ACROUT)
+13 SET ACRMSG=""
End DoDot:2
IF $GET(ACROUT)
QUIT
End DoDot:1
IF $GET(ACROUT)
QUIT
+14 IF $GET(ACROUT)
QUIT
+15 WRITE !?5,ACRMSG
+16 WRITE !
+17 IF $EXTRACT($GET(IOST))="C"
SET DIR(0)="E"
DO ^DIR
+18 QUIT
PRT(ACRD0,ACRDATES,ACRFILE,ACROUT) ;
+1 ;----- PRINT THE DATA
+2 ;
+3 NEW DIA,ACRDATA,ACRDATE,ACRENT,ACRENTN,ACRFLD,ACRFLDN,ACRNEW,ACROLD,ACRUSER,X,Y
+4 SET ACRCNT=$GET(ACRCNT)+1
+5 IF $EXTRACT($GET(IOST))="C"
IF ACRCNT>2
Begin DoDot:1
+6 DO HDR(ACRDATES,ACRFILE,.ACROUT)
+7 SET ACRCNT=1
End DoDot:1
+8 IF $EXTRACT($GET(IOST))="P"
IF ACRCNT>6
Begin DoDot:1
+9 DO HDR(ACRDATES,ACRFILE,.ACROUT)
+10 SET ACRCNT=1
End DoDot:1
+11 IF $GET(ACROUT)
QUIT
+12 SET DIA=+$PIECE(ACRFILE,U)
+13 SET ACRDATA=^DIA(DIA,ACRD0,0)
+14 SET ACRENT=$PIECE(ACRDATA,U)
+15 SET ACRENTN=$$ENTNAM(DIA,ACRD0)
+16 SET Y=$PIECE(ACRDATA,U,2)
+17 XECUTE ^DD("DD")
+18 SET ACRDATE=Y
+19 SET ACRFLD=$PIECE(ACRDATA,U,3)
+20 SET ACRFLDN=$$FLDNAM(DIA,ACRD0)
+21 SET ACRUSER=$PIECE(ACRDATA,U,4)
+22 ;I ACRUSER S ACRUSER=$P(^VA(200,ACRUSER,0),U) ;ACR*2.1*19.02 IM16848
+23 ;ACR*2.1*19.02 IM16848
IF ACRUSER
SET ACRUSER=$$NAME2^ACRFUTL1(ACRUSER)
+24 SET ACROLD=$$OLD(DIA,ACRD0)
+25 SET ACRNEW=$$NEW(DIA,ACRD0)
+26 ;
+27 WRITE !!
+28 WRITE "AUDIT #: "
+29 WRITE ACRD0
+30 WRITE ?40,"DATE/TIME RECORDED: "
+31 WRITE ACRDATE
+32 WRITE !
+33 WRITE "USER: "
+34 WRITE ACRUSER
+35 WRITE !
+36 WRITE "FILE ENTRY #: "
+37 WRITE ACRENT
+38 WRITE ?40,"FILE ENTRY NAME: "
+39 WRITE ACRENTN
+40 WRITE !
+41 WRITE "FIELD #: "
+42 WRITE ACRFLD
+43 WRITE ?40,"FIELD NAME: "
+44 WRITE ACRFLDN
+45 WRITE !
+46 WRITE "OLD VALUE: "
+47 WRITE ACROLD
+48 WRITE !
+49 WRITE "NEW VALUE: "
+50 WRITE ACRNEW
+51 QUIT
HDR(ACRDATES,ACRFILE,ACROUT) ;
+1 ;
+2 NEW DIR,I,X,Y
+3 IF $EXTRACT($GET(IOST))="C"
IF $GET(ACRPAGE)
Begin DoDot:1
+4 SET DIR(0)="E"
+5 DO ^DIR
+6 IF 'Y
SET ACROUT=1
End DoDot:1
IF $GET(ACROUT)
QUIT
+7 SET ACRPAGE=$GET(ACRPAGE)+1
+8 WRITE @IOF
+9 WRITE !,"AUDIT LISTING OF "_$PIECE(ACRFILE,U,2)_" FILE"
+10 WRITE ?IOM-20,$$NOW^ACRFUTL
+11 SET Y=$PIECE(ACRDATES,U)
+12 XECUTE ^DD("DD")
+13 WRITE !,"FROM "_Y
+14 SET Y=$PIECE(ACRDATES,U,2)
+15 XECUTE ^DD("DD")
+16 WRITE " TO "_Y
+17 WRITE ?IOM-20,"PAGE: ",ACRPAGE
+18 WRITE !
+19 FOR I=1:1:IOM
WRITE "-"
+20 WRITE !
+21 QUIT
FILE(ACRFILE) ;
+1 ;----- ASK WHICH FILE
+2 ;
+3 NEW DIC,DTOUT,DUOUT,X,Y
+4 SET ACRFILE=""
+5 SET DIC="^DIC("
+6 SET DIC(0)="AEMQ"
+7 DO ^DIC
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+9 IF +Y'>0
QUIT
+10 SET ACRFILE=Y
+11 QUIT
DATES(ACRDATES) ;
+1 ;----- ASK DATE RANGE
+2 ;
DLOOP ;----- DATE LOOP
+1 ;
+2 NEW ACRBEG,ACREND,DIR,DIRUT,DTOUT,DUOUT,X,Y
+3 SET ACRDATES=""
+4 WRITE !
+5 SET DIR(0)="DO^::E"
+6 SET DIR("A")="Begin with AUDIT DATE"
+7 SET DIR("?")="The first date in the audit date range"
+8 DO ^DIR
+9 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+10 IF Y=""
QUIT
+11 SET ACRBEG=Y
+12 SET DIR("A")="End with AUDIT DATE"
+13 SET DIR("?")="The last date in the audit date range"
+14 DO ^DIR
+15 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIRUT))
QUIT
+16 IF Y=""
QUIT
+17 SET ACREND=Y
+18 IF ACREND<ACRBEG
Begin DoDot:1
+19 WRITE *7,!?5,"ENDING DATE cannot be less than BEGINNING DATE"
End DoDot:1
GOTO DLOOP
+20 SET ACRDATES=ACRBEG_U_ACREND
+21 QUIT
ENTNAM(DIA,D0) ;
+1 ;----- EXTRINSIC FUNCTION - GET EXTERNAL FILE ENTRY NAME
+2 ;
+3 ; INPUT:
+4 ; DIA = FILE NUMBER
+5 ; D0 = INTERNAL NUMBER OF AUDIT ENTRY
+6 ;
+7 ; RETURNS EXTERNAL ENTRY NAME
+8 ;
+9 NEW %,C,X,Y
+10 IF '$DATA(^DIA(DIA,D0))
QUIT
+11 SET %=^DIC(DIA,0,"GL")
+12 SET X=^DIA(DIA,D0,0)
+13 SET X=$SELECT($DATA(@(%_+X_",0)")):$PIECE(^(0),U),1:"")
+14 SET C=$SELECT($DATA(^DD(DIA,.01,0)):$PIECE(^(0),U,2),1:"")
+15 SET Y=X
+16 IF Y]""
IF C]""
DO Y^DIQ
+17 SET X=Y
+18 QUIT X
+19 ;
FLDNAM(DIA,D0) ;
+1 ;----- EXTRINSIC FUNCTION - GET FIELD NAME
+2 ;
+3 ; INPUT:
+4 ; DIA = FILE NUMBER
+5 ; D0 = INTERNAL NUMBER OF AUDIT ENTRY
+6 ;
+7 ; RETURNS EXTERNAL FIELD NAME
+8 ;
+9 NEW X,Y
+10 SET Y(1.1,1.1)=$SELECT($DATA(^DIA(DIA,D0,0)):$PIECE(^(0),U,3),1:"")
+11 XECUTE ^DD(1.1,1.1,9.2)
+12 KILL Y(1.1)
+13 SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+14 QUIT X
+15 ;
OLD(DIA,D0) ;
+1 ;----- EXTRINSIC FUNCTION - GET OLD VALUE
+2 ;
+3 ; INPUT:
+4 ; DIA = FILE NUMBER
+5 ; D0 = INTERNAL NUMBER OF AUDIT ENTRY
+6 ;
+7 ; RETURNS OLD VALUE OF AUDIT FIELD
+8 ;
+9 NEW X
+10 SET X=$SELECT($DATA(^DIA(DIA,D0,2)):^(2),1:"<no previous value>")
+11 QUIT X
+12 ;
NEW(DIA,D0) ;
+1 ;----- EXTRINSIC FUNCTION - GET NEW VALUE
+2 ;
+3 ; INPUT:
+4 ; DIA = FILE NUMBER
+5 ; D0 = INTERNAL NUMBER OF AUDIT ENTRY
+6 ;
+7 ; RETURNS NEW VALUE OF AUDIT FIELD
+8 ;
+9 NEW X
+10 SET X=$SELECT($DATA(^DIA(DIA,D0,3)):^(3),1:"<deleted>")
+11 QUIT X
+12 ;
TXT ;----- PRINT OPTION DESCRIPTION
+1 ;
+2 NEW I,X
+3 FOR I=1:1
SET X=$PIECE($TEXT(DESC+I),";",3)
IF X["$$END"
QUIT
WRITE !,X
+4 QUIT
ONE ;EP -- DISPLAY AUDIT TRAIL FOR ONE ENTRY
+1 ;
+2 NEW ACRFILE,DA,DIC,X,Y,ZTSAVE
+3 ;
+4 DO FILE(.ACRFILE)
+5 IF ACRFILE']""
QUIT
+6 SET DIC=^DIC(+ACRFILE,0,"GL")
+7 ;
+8 DO ENTRY(DIC,.Y)
+9 IF +Y'>0
QUIT
+10 SET DA=+Y
+11 ;
+12 SET ZTSAVE("DIC")=""
+13 SET ZTSAVE("DA")=""
+14 SET ZTSAVE("ACRFILE")=""
+15 DO QUE^ACRFUTL("DQ1^ACRFAUD",.ZTSAVE,"ARMS AUDIT REPORT")
+16 QUIT
DQ1 ;EP -- QUEUED REPORT STARTS HERE
+1 ;
+2 NEW ACRPAGE
+3 DO HDR1(ACRFILE,DA,.ACROUT)
+4 DO DIQ(DIC,DA)
+5 DO ^%ZISC
+6 QUIT
ENTRY(DIC,Y) ;
+1 ;----- LOOK UP FILE ENTRY
+2 ;
+3 SET DIC(0)="AEMQ"
+4 DO ^DIC
+5 QUIT
DIQ(DIC,DA) ;
+1 ;----- CALL EN^DIQ TO DISPLAY THE ENTRY
+2 ;
+3 SET DIQ(0)="ACR"
+4 DO EN^DIQ
+5 QUIT
HDR1(ACRFILE,DA,ACROUT) ;
+1 ;----- PRINT HEADER FOR ONE ENTRY AUDIT REPORT
+2 ;
+3 NEW ACRENT,DIR,I,X,Y
+4 IF $EXTRACT($GET(IOST))="C"
IF $GET(ACRPAGE)
Begin DoDot:1
+5 SET DIR(0)="E"
+6 DO ^DIR
+7 IF 'Y
SET ACROUT=1
End DoDot:1
IF $GET(ACROUT)
QUIT
+8 SET ACRPAGE=$GET(ACRPAGE)+1
+9 WRITE @IOF
+10 WRITE !,"AUDIT LISTING OF ",$PIECE(ACRFILE,U,2)," FILE ENTRY "
+11 WRITE ?IOM-20,$$NOW^ACRFUTL
+12 WRITE !?IOM-20,"PAGE: ",ACRPAGE
+13 WRITE !
+14 FOR I=1:1:IOM
WRITE "-"
+15 WRITE !
+16 QUIT
