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
