XUAPURGE.m

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 ---XUAPURGE   1268     printed  Apr 23, 2025@18:23:30                                                                                                                                                                                                    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