ZUA ;SF/LJP - AUDIT ACCESS ;01/27/20 15:05
;;8.0;KERNEL;**701**;Jul 10, 1995;Build 11
;Per VA Directive 6402, this routine should not be modified.
FAA ;Return failed access attempts
K X S X(0)=0 F I=1:1 S X(I)=$O(^%ZUA(3.05,"U",XUF,X(I-1))) Q:X(I)'>0 S %H=$P($H,",",2),$P(^%ZUA(3.05,X(I),0),U,7)=DT_(%H\60#60/100+(%H\3600)+(%H#60/10000)/100)
Q
FAAL ;Record failed access attempts
;P701 reduce lock contention
S Z1=$$NOW^XLFDT
F1 L +^%ZUA(3.05,0):$G(DILOCKTM,5) I $D(^%ZUA(3.05,Z1,0)) S Z1=Z1+.000001 L -^%ZUA(3.05,0) G F1
S $P(^(0),"^",3,4)=Z1_"^"_($P(^%ZUA(3.05,0),"^",4)+1)
;p701 use XUF(.2) instead of XUT
S XUF(.3)=$G(XUF(.3))
S ^%ZUA(3.05,Z1,0)=IOS_U_$P(XUVOL,U,1)_U_XUF(.1)_U_XUF(.2)_U_$P(XUCI,",",1)_U_XUF(.3)_U_$S($D(IO("ZIO")):IO("ZIO"),1:"") L -^%ZUA(3.05,0)
I XUF=2 F I=1:1:XUF(.2) S ^%ZUA(3.05,Z1,1,I,0)=XUF(I)
;I XUF(.3) S ^%ZUA(3.05,"U",$P(XUVOL,U,1)_","_$P(XUCI,",",1)_","_XUF(.3),Z1)=""
K Z1 Q
PRGM ;Programmer mode log.
S %H=$P($H,",",2),Z1=DT_(%H\60#60/100+(%H\3600)+(%H#60/10000)/100)
P1 L +^%ZUA(3.07,0) I $D(^%ZUA(3.07,Z1,0)) S Z1=Z1+.000001 G P1
S $P(^(0),"^",3,4)=Z1_"^"_($P(^%ZUA(3.07,0),"^",4)+1)
S ^%ZUA(3.07,Z1,0)=DUZ_U_$P(XUCI,",",1)_U_$P(XUVOL,U,1) L -^%ZUA(3.07,0)
K Z1 Q
PURG ;Purge both failed access and programmer mode logs to 30 days.
S X="T-30",%DT="" D ^%DT Q:Y'>0 S BD=2000000,ED=Y
F ZUI=3.05,3.07 S BDATE=BD,EDATE=ED D PRG
K BD,ED
EXIT S:$D(ZTSK) ZTREQ="@" K BDATE,EDATE,REC Q
PMPURG ;Purge programmer mode log.
S ZUI=3.07 D PRG G EXIT
PURGE ;Purge failed access log.
S ZUI=3.05 D PRG G EXIT
PRG S C=0 F REC=BDATE-.000001:0 S REC=$O(^%ZUA(ZUI,REC)) Q:REC'>0!(REC>EDATE) K ^(REC) S C=C+1
L +^%ZUA(ZUI,0) S $P(^(0),"^",4)=$P(^%ZUA(ZUI,0),"^",4)-C L -^%ZUA(ZUI,0) Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZUA 1767 printed Oct 16, 2024@18:17:26 Page 2
ZUA ;SF/LJP - AUDIT ACCESS ;01/27/20 15:05
+1 ;;8.0;KERNEL;**701**;Jul 10, 1995;Build 11
+2 ;Per VA Directive 6402, this routine should not be modified.
FAA ;Return failed access attempts
+1 KILL X
SET X(0)=0
FOR I=1:1
SET X(I)=$ORDER(^%ZUA(3.05,"U",XUF,X(I-1)))
if X(I)'>0
QUIT
SET %H=$PIECE($HOROLOG,",",2)
SET $PIECE(^%ZUA(3.05,X(I),0),U,7)=DT_(%H\60#60/100+(%H\3600)+(%H#60/10000)/100)
+2 QUIT
FAAL ;Record failed access attempts
+1 ;P701 reduce lock contention
+2 SET Z1=$$NOW^XLFDT
F1 LOCK +^%ZUA(3.05,0):$GET(DILOCKTM,5)
IF $DATA(^%ZUA(3.05,Z1,0))
SET Z1=Z1+.000001
LOCK -^%ZUA(3.05,0)
GOTO F1
+1 SET $PIECE(^(0),"^",3,4)=Z1_"^"_($PIECE(^%ZUA(3.05,0),"^",4)+1)
+2 ;p701 use XUF(.2) instead of XUT
+3 SET XUF(.3)=$GET(XUF(.3))
+4 SET ^%ZUA(3.05,Z1,0)=IOS_U_$PIECE(XUVOL,U,1)_U_XUF(.1)_U_XUF(.2)_U_$PIECE(XUCI,",",1)_U_XUF(.3)_U_$SELECT($DATA(IO("ZIO")):IO("ZIO"),1:"")
LOCK -^%ZUA(3.05,0)
+5 IF XUF=2
FOR I=1:1:XUF(.2)
SET ^%ZUA(3.05,Z1,1,I,0)=XUF(I)
+6 ;I XUF(.3) S ^%ZUA(3.05,"U",$P(XUVOL,U,1)_","_$P(XUCI,",",1)_","_XUF(.3),Z1)=""
+7 KILL Z1
QUIT
PRGM ;Programmer mode log.
+1 SET %H=$PIECE($HOROLOG,",",2)
SET Z1=DT_(%H\60#60/100+(%H\3600)+(%H#60/10000)/100)
P1 LOCK +^%ZUA(3.07,0)
IF $DATA(^%ZUA(3.07,Z1,0))
SET Z1=Z1+.000001
GOTO P1
+1 SET $PIECE(^(0),"^",3,4)=Z1_"^"_($PIECE(^%ZUA(3.07,0),"^",4)+1)
+2 SET ^%ZUA(3.07,Z1,0)=DUZ_U_$PIECE(XUCI,",",1)_U_$PIECE(XUVOL,U,1)
LOCK -^%ZUA(3.07,0)
+3 KILL Z1
QUIT
PURG ;Purge both failed access and programmer mode logs to 30 days.
+1 SET X="T-30"
SET %DT=""
DO ^%DT
if Y'>0
QUIT
SET BD=2000000
SET ED=Y
+2 FOR ZUI=3.05,3.07
SET BDATE=BD
SET EDATE=ED
DO PRG
+3 KILL BD,ED
EXIT if $DATA(ZTSK)
SET ZTREQ="@"
KILL BDATE,EDATE,REC
QUIT
PMPURG ;Purge programmer mode log.
+1 SET ZUI=3.07
DO PRG
GOTO EXIT
PURGE ;Purge failed access log.
+1 SET ZUI=3.05
DO PRG
GOTO EXIT
PRG SET C=0
FOR REC=BDATE-.000001:0
SET REC=$ORDER(^%ZUA(ZUI,REC))
if REC'>0!(REC>EDATE)
QUIT
KILL ^(REC)
SET C=C+1
+1 LOCK +^%ZUA(ZUI,0)
SET $PIECE(^(0),"^",4)=$PIECE(^%ZUA(ZUI,0),"^",4)-C
LOCK -^%ZUA(ZUI,0)
QUIT
+2 ;
