XUAPURGE ;SF/RWF - PURGE %ZUA GLOBAL FILES. ;1/22/93 14:37 ;
;;8.0;KERNEL;;Jul 10, 1995
PMPURGE ;Programmer mode purge
D BEG G END:'$D(EDATE)
S ZTIO="",ZTRTN="PMPURG^ZUA",ZTDESC="Purge Programmer Mode Entry Log",ZTUCI=^%ZOSF("MGR") F G="BDATE","EDATE" S ZTSAVE(G)=""
D ^%ZTLOAD G OKEND
OKEND W:$D(ZTSK) !,"Request queued"
END K %DT,BDATE,EDATE,ZTIO,ZTRTN,ZTUCI,ZTSAVE,ZTSK Q
BEG W !!,"You will be asked for a date range to purge, Begin to End"
S %DT("A")="PURGE BEGIN DATE: ",%DT="AETX" D ^%DT S BDATE=Y G:Y<1 END S %DT(0)=BDATE,%DT("A")="PURGE END DATE: " D ^%DT S EDATE=Y G:Y<1 END
Q
FAPURGE ;Failed access purge
D BEG G:'$D(EDATE) END
S ZTIO="",ZTRTN="PURGE^ZUA",ZTDESC="Purge User Failed Access Attempts",ZTUCI=^%ZOSF("MGR") F G="BDATE","EDATE" S ZTSAVE(G)=""
D ^%ZTLOAD
G OKEND
OPTPURGE ;Option audit purge
D BEG G:'$D(EDATE) END
S ZTIO="",ZTRTN="PURGE^XUAPURGE",ZTDESC="Purge Menu Option Audit Entries" F G="BDATE","EDATE" S ZTSAVE(G)=""
D ^%ZTLOAD K ZTIO,ZTRTN,ZTDESC,ZTUCI,ZTSAVE
G OKEND
PURGE F REC=BDATE-.000001:0 S REC=$O(^XUSEC(19,REC)) Q:REC'>0!(REC>EDATE) S DIK="^XUSEC(19,",DA=REC D ^DIK K DA
G END
PRFAA ;Print faild access log with text
I '$D(^XUSEC("XUMGR",DUZ)) S X="" Q
S X2=$P(D0,".") D DE^XUSHSHP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUAPURGE 1268 printed Nov 22, 2024@17:19:08 Page 2
XUAPURGE ;SF/RWF - PURGE %ZUA GLOBAL FILES. ;1/22/93 14:37 ;
+1 ;;8.0;KERNEL;;Jul 10, 1995
PMPURGE ;Programmer mode purge
+1 DO BEG
if '$DATA(EDATE)
GOTO END
+2 SET ZTIO=""
SET ZTRTN="PMPURG^ZUA"
SET ZTDESC="Purge Programmer Mode Entry Log"
SET ZTUCI=^%ZOSF("MGR")
FOR G="BDATE","EDATE"
SET ZTSAVE(G)=""
+3 DO ^%ZTLOAD
GOTO OKEND
OKEND if $DATA(ZTSK)
WRITE !,"Request queued"
END KILL %DT,BDATE,EDATE,ZTIO,ZTRTN,ZTUCI,ZTSAVE,ZTSK
QUIT
BEG WRITE !!,"You will be asked for a date range to purge, Begin to End"
+1 SET %DT("A")="PURGE BEGIN DATE: "
SET %DT="AETX"
DO ^%DT
SET BDATE=Y
if Y<1
GOTO END
SET %DT(0)=BDATE
SET %DT("A")="PURGE END DATE: "
DO ^%DT
SET EDATE=Y
if Y<1
GOTO END
+2 QUIT
FAPURGE ;Failed access purge
+1 DO BEG
if '$DATA(EDATE)
GOTO END
+2 SET ZTIO=""
SET ZTRTN="PURGE^ZUA"
SET ZTDESC="Purge User Failed Access Attempts"
SET ZTUCI=^%ZOSF("MGR")
FOR G="BDATE","EDATE"
SET ZTSAVE(G)=""
+3 DO ^%ZTLOAD
+4 GOTO OKEND
OPTPURGE ;Option audit purge
+1 DO BEG
if '$DATA(EDATE)
GOTO END
+2 SET ZTIO=""
SET ZTRTN="PURGE^XUAPURGE"
SET ZTDESC="Purge Menu Option Audit Entries"
FOR G="BDATE","EDATE"
SET ZTSAVE(G)=""
+3 DO ^%ZTLOAD
KILL ZTIO,ZTRTN,ZTDESC,ZTUCI,ZTSAVE
+4 GOTO OKEND
PURGE FOR REC=BDATE-.000001:0
SET REC=$ORDER(^XUSEC(19,REC))
if REC'>0!(REC>EDATE)
QUIT
SET DIK="^XUSEC(19,"
SET DA=REC
DO ^DIK
KILL DA
+1 GOTO END
PRFAA ;Print faild access log with text
+1 IF '$DATA(^XUSEC("XUMGR",DUZ))
SET X=""
QUIT
+2 SET X2=$PIECE(D0,".")
DO DE^XUSHSHP
+3 QUIT
