- DGSEC3 ;ALB/RMO - Purge Record of User Access from Security Log ; [ 09/13/2001 4:02 PM ]
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;IHS/ANMC/LJF 9/6/2000 improved error message when parameter not set
- ;
- I '$D(^XUSEC("DG SECURITY OFFICER",DUZ)) W !!?3,*7,"You do not have the appropriate access privileges to purge user access." Q
- ;I '+$P(^DG(43,1,0),"^",33) W !!?3,*7,"Record of user access can not be purged from the security log." Q
- I '+$P(^DG(43,1,0),"^",33) W !!?3,*7,"***Record of user access can not be purged from the security log!!",!?3,"Please use the Update Security Parameters option to enter # of days",!?3,"to maintain sensitivity.***" Q ;IHS/ANMC/LJF 9/6/2000
- ASKPAT R !!,"Select PATIENT: ",X:DTIME G Q:'$T!(X="^")!(X="") I $E(X,1,3)="ALL"!($E(X,1,3)="all") S DFN="ALL" G ASKDTE
- S DIC="^DGSL(38.1,",DIC(0)="EMQ",DGSENFLG="" D ^DIC K DGSENFLG I Y>0 S DFN=+Y G ASKDTE
- W:X'["?" *7 W !!?3,"Enter 'ALL' or a select patient to purge user access from security log." G ASKPAT
- ;
- ASKDTE D H^DGUTL S DGSDFLG=+$P(^DG(43,1,0),"^",33),X1=DT,X2="-"_(DGSDFLG+1) D C^%DTC S $P(DGSDFLG,"^",2)=X
- W !!?1,*7,"Record of user access can not be purged prior to ",+DGSDFLG," day(s), please",!?1,"select a day on or before " S Y=$P(DGSDFLG,"^",2) D DT^DIQ W "." D DTRNG^DGSEC2 G Q:DGPOP
- ;
- ASKPRT W !!,"Do you want to print users as they are purged" S %=2 D YN^DICN G Q:%<0 S DGPRT=$S(%=2:"QUE",1:"") I '% W !!,"Enter 'YES' to print users being purged, or 'NO' to schedule purge." G ASKPRT
- S DGPGM="PURUSR^DGSEC3",DGVAR="DFN^DGBEGDT^DGENDDT^DGPRT^DUZ" I DGPRT="" W ! D ZIS^DGUTQ G Q:POP,PURUSR
- I DGPRT="QUE" S ION="" W ! D QUE^DGUTQ G Q:X["^" S IOP="HOME" D ^%ZIS K IOP G Q
- ;
- PURUSR I DGPRT="" S DGCNT=0 W !!,"Purge User Access from Security Log started " D H^DGUTL S Y=DGTIME D DT^DIQ W ".",!
- D PURSEL:DFN,PURALL:DFN="ALL" I DGPRT="" W !!,"Purge completed " D H^DGUTL S Y=DGTIME D DT^DIQ W ". ","Number of records purged: ",DGCNT
- ;
- Q K DFN,DGBEGDT,DGDTE,DGENDDT,DGCNT,DGPOP,DGPGM,DGPRT,DGSDFLG,DGSL0,DGVAR,POP D CLOSE^DGUTQ
- Q
- ;
- PURSEL F DGDTE=DGENDDT:0 S DGDTE=$O(^DGSL(38.1,DFN,"D",DGDTE)) Q:'DGDTE!(DGBEGDT<DGDTE) I $D(^(DGDTE,0)) S DGSL0=^(0) D DELUSR
- Q
- ;
- PURALL F DGDTE=DGENDDT:0 S DGDTE=$O(^DGSL(38.1,"AD",DGDTE)) Q:'DGDTE!(DGBEGDT<DGDTE) F DFN=0:0 S DFN=$O(^DGSL(38.1,"AD",DGDTE,DFN)) Q:'DFN I $D(^DGSL(38.1,DFN,"D",DGDTE,0)) S DGSL0=^(0) D DELUSR
- Q
- ;
- DELUSR S DA(1)=DFN,DA=DGDTE,DIK="^DGSL(38.1,DFN,""D""," D ^DIK
- I DGPRT="" W !," ...",$S($D(^VA(200,+$P(DGSL0,"^",2),0)):$E($P(^(0),"^"),1,15),1:"Unknown")," accessed ",$S($D(^DPT(DFN,0)):$E($P(^(0),"^"),1,20),1:"Unknown")," on " S Y=$P(DGSL0,"^") D DT^DIQ S DGCNT=DGCNT+1
- Q
- DGSEC3 ;ALB/RMO - Purge Record of User Access from Security Log ; [ 09/13/2001 4:02 PM ]
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;IHS/ANMC/LJF 9/6/2000 improved error message when parameter not set
- +3 ;
- +4 IF '$DATA(^XUSEC("DG SECURITY OFFICER",DUZ))
- WRITE !!?3,*7,"You do not have the appropriate access privileges to purge user access."
- QUIT
- +5 ;I '+$P(^DG(43,1,0),"^",33) W !!?3,*7,"Record of user access can not be purged from the security log." Q
- +6 ;IHS/ANMC/LJF 9/6/2000
- IF '+$PIECE(^DG(43,1,0),"^",33)
- WRITE !!?3,*7,"***Record of user access can not be purged from the security log!!",!?3,"Please use the Update Security Parameters option to enter # of days",!?3,"to maintain sensitivity.***"
- QUIT
- ASKPAT READ !!,"Select PATIENT: ",X:DTIME
- IF '$TEST!(X="^")!(X="")
- GOTO Q
- IF $EXTRACT(X,1,3)="ALL"!($EXTRACT(X,1,3)="all")
- SET DFN="ALL"
- GOTO ASKDTE
- +1 SET DIC="^DGSL(38.1,"
- SET DIC(0)="EMQ"
- SET DGSENFLG=""
- DO ^DIC
- KILL DGSENFLG
- IF Y>0
- SET DFN=+Y
- GOTO ASKDTE
- +2 IF X'["?"
- WRITE *7
- WRITE !!?3,"Enter 'ALL' or a select patient to purge user access from security log."
- GOTO ASKPAT
- +3 ;
- ASKDTE DO H^DGUTL
- SET DGSDFLG=+$PIECE(^DG(43,1,0),"^",33)
- SET X1=DT
- SET X2="-"_(DGSDFLG+1)
- DO C^%DTC
- SET $PIECE(DGSDFLG,"^",2)=X
- +1 WRITE !!?1,*7,"Record of user access can not be purged prior to ",+DGSDFLG," day(s), please",!?1,"select a day on or before "
- SET Y=$PIECE(DGSDFLG,"^",2)
- DO DT^DIQ
- WRITE "."
- DO DTRNG^DGSEC2
- IF DGPOP
- GOTO Q
- +2 ;
- ASKPRT WRITE !!,"Do you want to print users as they are purged"
- SET %=2
- DO YN^DICN
- IF %<0
- GOTO Q
- SET DGPRT=$SELECT(%=2:"QUE",1:"")
- IF '%
- WRITE !!,"Enter 'YES' to print users being purged, or 'NO' to schedule purge."
- GOTO ASKPRT
- +1 SET DGPGM="PURUSR^DGSEC3"
- SET DGVAR="DFN^DGBEGDT^DGENDDT^DGPRT^DUZ"
- IF DGPRT=""
- WRITE !
- DO ZIS^DGUTQ
- IF POP
- GOTO Q
- GOTO PURUSR
- +2 IF DGPRT="QUE"
- SET ION=""
- WRITE !
- DO QUE^DGUTQ
- IF X["^"
- GOTO Q
- SET IOP="HOME"
- DO ^%ZIS
- KILL IOP
- GOTO Q
- +3 ;
- PURUSR IF DGPRT=""
- SET DGCNT=0
- WRITE !!,"Purge User Access from Security Log started "
- DO H^DGUTL
- SET Y=DGTIME
- DO DT^DIQ
- WRITE ".",!
- +1 IF DFN
- DO PURSEL
- IF DFN="ALL"
- DO PURALL
- IF DGPRT=""
- WRITE !!,"Purge completed "
- DO H^DGUTL
- SET Y=DGTIME
- DO DT^DIQ
- WRITE ". ","Number of records purged: ",DGCNT
- +2 ;
- Q KILL DFN,DGBEGDT,DGDTE,DGENDDT,DGCNT,DGPOP,DGPGM,DGPRT,DGSDFLG,DGSL0,DGVAR,POP
- DO CLOSE^DGUTQ
- +1 QUIT
- +2 ;
- PURSEL FOR DGDTE=DGENDDT:0
- SET DGDTE=$ORDER(^DGSL(38.1,DFN,"D",DGDTE))
- IF 'DGDTE!(DGBEGDT<DGDTE)
- QUIT
- IF $DATA(^(DGDTE,0))
- SET DGSL0=^(0)
- DO DELUSR
- +1 QUIT
- +2 ;
- PURALL FOR DGDTE=DGENDDT:0
- SET DGDTE=$ORDER(^DGSL(38.1,"AD",DGDTE))
- IF 'DGDTE!(DGBEGDT<DGDTE)
- QUIT
- FOR DFN=0:0
- SET DFN=$ORDER(^DGSL(38.1,"AD",DGDTE,DFN))
- IF 'DFN
- QUIT
- IF $DATA(^DGSL(38.1,DFN,"D",DGDTE,0))
- SET DGSL0=^(0)
- DO DELUSR
- +1 QUIT
- +2 ;
- DELUSR SET DA(1)=DFN
- SET DA=DGDTE
- SET DIK="^DGSL(38.1,DFN,""D"","
- DO ^DIK
- +1 IF DGPRT=""
- WRITE !," ...",$SELECT($DATA(^VA(200,+$PIECE(DGSL0,"^",2),0)):$EXTRACT($PIECE(^(0),"^"),1,15),1:"Unknown")," accessed ",$SELECT($DATA(^DPT(DFN,0)):$EXTRACT($PIECE(^(0),"^"),1,20),1:"Unknown")," on "
- SET Y=$PIECE(DGSL0,"^")
- DO DT^DIQ
- SET DGCNT=DGCNT+1
- +2 QUIT
