- 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
