BGUPURGE.m

BGUPURGE ; IHS/OIT/MJL - PURGE ROUTINE FOR BGUSEC ;

 ;;1.5;BGU;;MAY 26, 2005

 ;;1.0;BGU

SCPURG ;EP Called by option BGU PURGE SIGNON

 ;Purge BGU sign-on log

 S DIR("?")="Enter Y if you want to purge the BGU sign-on log"

 S DIR(0)="Y",DIR("A")="Purge BGU Sign-on log older than 30 days?",DIR("B")="NO" D ^DIR Q:$D(DIRUT)

 Q:'Y

 S X1=DT,X2=-30 D C^%DTC S BGUDT=X I $O(^BGUSEC(0))'>0 G SCEXIT

 S DIK="^BGUSEC(" F DA=0:0 S DA=$O(^BGUSEC(DA)) Q:(DA'>0)!(DA>BGUDT)  D ^DIK

 W !,"BGU Sign-on log has been purged.",!

SCEXIT K DIK,DA,BGUDT,X1,X2 Q

BGUPURGE  ; IHS/OIT/MJL - PURGE ROUTINE FOR BGUSEC ;

 +1       ;;1.5;BGU;;MAY 26, 2005

 +2       ;;1.0;BGU

SCPURG    ;EP Called by option BGU PURGE SIGNON

 +1       ;Purge BGU sign-on log

 +2        SET DIR("?")="Enter Y if you want to purge the BGU sign-on log"

 +3        SET DIR(0)="Y"

           SET DIR("A")="Purge BGU Sign-on log older than 30 days?"

           SET DIR("B")="NO"

           DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +4        IF 'Y

               QUIT 

 +5        SET X1=DT

           SET X2=-30

           DO C^%DTC

           SET BGUDT=X

           IF $ORDER(^BGUSEC(0))'>0

               GOTO SCEXIT

 +6        SET DIK="^BGUSEC("

           FOR DA=0:0

               SET DA=$ORDER(^BGUSEC(DA))

               IF (DA'>0)!(DA>BGUDT)

                   QUIT 

               DO ^DIK

 +7        WRITE !,"BGU Sign-on log has been purged.",!

SCEXIT     KILL DIK,DA,BGUDT,X1,X2

           QUIT