DGSEC1 ;ALB/RMO-MAS Security Options ; [ 01/04/2002 7:06 AM ]
;;5.3;Registration;**222,149,214,1010,1015**;Aug 13, 1993;Build 21
;IHS/ANMC/LJF 9/06/2000 added IHS entry point for protocol
; 9/07/2000 added check to quit loop if called by protocol
; changed SSN to chart # in bulletin
; 9/08/2000 changed SSN to chart # in purge report
; 9/14/2000 commented out call to SECA08^VAFCDD01
; no need to update Pivot table
; 1/04/2002 using IHS template for editing
;
;cmi/anch/maw 05/03/2009 PATCH 1010 RQMT49 mods under subroutine 4
;
N I,X,DIK
G:$D(^DOPT("DGSEC1",4)) A S ^DOPT("DGSEC1",0)="Security Menu Options^1N^" F I=1:1 S X=$T(@(I)+1) Q:X="" S ^DOPT("DGSEC1",I,0)=$P(X,";;",2,99)
S DIK="^DOPT(""DGSEC1""," D IXALL^DIK
A N DIC,Y,X
W !! S DIC="^DOPT(""DGSEC1"",",DIC(0)="AEQM" D ^DIC Q:Y<0 D @+Y G A
1 ;
;;Enter/Edit Patient Security Level
I $G(BDGSECL) K BDGSECL D Q Q ;IHS/ANMC/LJF 9/7/2000
N DA,DLAYGO,DR,DIC,X,Y
I '$D(^XUSEC("DG SENSITIVITY",DUZ)) W !!?3,$C(7),"You do not have the appropriate access privileges to assign security." Q
S DIC("A")="Select PATIENT NAME: ",DIC="^DGSL(38.1,",DLAYGO=38.1,DIC(0)="AELMQ",DGSENFLG="" W ! D ^DIC K DIC("A"),DGSENFLG Q:Y<0
S DA=+Y
;
IHS ;EP; -- entry point from IHS protocol;IHS/ANMC/LJF 9/6/2000
S DIE="^DGSL(38.1,",DR="[BDG ENTER/EDIT SECURITY]" D ^DIE K DIE,DA,DR Q ;IHS/ANMC/LJF 1/04/2002
;
; warn user if attempting to edit security level from remote source
N SECSRCE,OK
S SECSRCE=$P($G(^DGSL(38.1,DA,0)),"^",5)
I SECSRCE'="" D G:'OK 1
.W !!?3,$C(7),">>> WARNING: The source that assigned this patient's security level"
.W !,?16,"is '"_$S(SECSRCE="AAC":"VBA",1:"UNKNOWN")_"'. Editing the patient security level will"
.W !,?16,"cause the security source to be deleted.",!
.S OK=$$RUSURE()
;
N SENSBEF,SENSAFTR
S SENSBEF=$P($G(^DGSL(38.1,DA,0)),"^",2)
S DIE="^DGSL(38.1,"
S DR="2;3////"_DUZ_";4///NOW"
I SECSRCE'="",$G(OK) S DR=DR_";5////@"
D ^DIE
K DE,DQ,DIE
S SENSAFTR=$P($G(^DGSL(38.1,DA,0)),"^",2)
;
;CIRN CHANGES
;I SENSBEF'=SENSAFTR D SECA08^VAFCDD01(DA) ;IHS/ANMC/LJF 9/14/2000
K SENSBEF,SENSAFTR
G 1
;
BULTIN ;This bulletin is sent if a patient's sensitivity is removed.
N SECSRCE,SUB,DIC,X,Y S SUB=1
K DGB I $D(^DG(43,1,"NOT")),+$P(^("NOT"),"^",11) S DGB=11
Q:'$D(DGB)
S DGB=+$P($G(^DG(43,1,"NOT")),U,DGB) Q:'DGB
S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB)
N XMB,XMY,XMY0,XMZ,DGI
S XMB="DG SENSITIVITY REMOVED" S Y=$$NOW^XLFDT() X ^DD("DD") S XMB(7)=Y
S XMB(1)="UNKNOWN",X=+$P(^DGSL(38.1,DA,0),"^",3) I X D
.S DIC="^VA(200,",DIC(0)="MO",X="`"_X D ^DIC
.S:Y>0 XMB(1)=$P(Y,U,2) S:XMB(1)="" XMB(1)="UNKNOWN"
.Q
;S XMB(2)=$S($D(^DPT(DA,0)):$P(^(0),"^")_" ("_$P(^(0),"^",9)_")",1:"UNKNOWN")
S XMB(2)=$$VAL^XBDIQ1(2,DA,.01)_" (#"_$$HRCN^BDGF2(DA,DUZ(2))_")" ;IHS/ANMC/LJF 9/7/2000
F DGI=3:1:6 S XMB(DGI)=""
S SECSRCE=$P($G(^DGSL(38.1,DA,0)),"^",5) I SECSRCE'="" D
.S XMB(3)=" >>> WARNING: The source of the patient sensitivity"
.S XMB(4)=" removed was "_$S(SECSRCE="AAC":"VBA",1:"UNKNOWN")
I $D(^DGSL(38.1,DA,0)),'$O(^("D",0)) D
.S XMB(5)="No record of user access, patient should be removed"
.S XMB(6)="from the security log."
S XMY("G."_DGB)="" D SEND^DGSEC(.XMB,.XMY)
Q
2 ;
;;Display User Access to Patient Record
G ^DGSEC2
3 ;
;;Purge Record of User Access from Security Log
G ^DGSEC3
4 ;
;;Purge Non-sensitive Patients from Security Log
I '$D(^XUSEC("DG SECURITY OFFICER",DUZ)) W !!?3,$C(7),"You do not have the appropriate access privileges to purge patients." Q
ASKPUR N %
W !!,"Are you sure you want to purge all non-sensitive patients" S %=2 D YN^DICN G Q:%<0!(%=2)
I '% W !!,"Enter 'YES' to purge non-sensitive patients, or 'NO' to exit this process." G ASKPUR
D DTR ;cmi/maw 5/3/2009 PATCH 1010 RQMT49
G Q:'$G(BDGSD)
;
ASKPRT W !!,"Do you want to print patients as they are purged" S %=2 D YN^DICN G Q:%<0 S DGPRT=$S(%=2:"QUE",1:"") I '% W !!,"Enter 'YES' to print patients being purged, or 'NO' to schedule purge." G ASKPRT
S DGPGM="PURNON^DGSEC1",DGVAR="DGPRT^DUZ" I DGPRT="" W ! D ZIS^DGUTQ G Q:POP,PURNON
I DGPRT="QUE" S ION="" W ! D QUE^DGUTQ G Q
;
PURNON N DIC,Y
I DGPRT="" S DGCNT=0 W !!,"Purge Non-sensitive Patients from Security Log started " D H^DGUTL S Y=DGTIME D DT^DIQ W ".",!
;F DFN=0:0 S DFN=$O(^DGSL(38.1,"ANS",DFN)) Q:'DFN I $D(^DGSL(38.1,DFN,0)),'$P(^(0),"^",2) S DA=DFN,DIK="^DGSL(38.1," D ^DIK I DGPRT="" W !," ...",$S($D(^DPT(DFN,0)):$P(^(0),"^")_" ("_$P(^(0),"^",9)_")",1:"Unknown") S DGCNT=DGCNT+1
;F DFN=0:0 S DFN=$O(^DGSL(38.1,"ANS",DFN)) Q:'DFN I $D(^DGSL(38.1,DFN,0)),'$P(^(0),"^",2) S DA=DFN,DIK="^DGSL(38.1," D ^DIK I DGPRT="" W !," ...",$S($D(^DPT(DFN,0)):$P(^(0),"^")_" ("_$$HRCN^BDGF2(DFN,DUZ(2))_")",1:"Unknown") S DGCNT=DGCNT+1
F DFN=0:0 S DFN=$O(^DGSL(38.1,"ANS",DFN)) Q:'DFN I $D(^DGSL(38.1,DFN,0)),'$P(^(0),"^",2),$P($P(^(0),"^",4),",")<BDGED,$P($P(^(0),"^",4),".")>BDGSD S DA=DFN,DIK="^DGSL(38.1," D ^DIK I DGPRT="" D ;cmi/maw 5/3/2009 PATCH 1010 RQMT49
. W !," ...",$S($D(^DPT(DFN,0)):$P(^(0),"^")_" ("_$$HRCN^BDGF2(DFN,DUZ(2))_")",1:"Unknown") S DGCNT=DGCNT+1 ;IHS/ANMC/LJF 9/8/2000
I DGPRT="" W !!,"Purge completed " D H^DGUTL S Y=DGTIME D DT^DIQ W ". ","Number of records purged: ",DGCNT
;
Q K DFN,DGCNT,DGPGM,DGPRT,DGVAR,POP D CLOSE^DGUTQ
Q
;
;
RUSURE() ; Description: Asks user if they are sure they want to edit the DG SECURITY LOG record.
;
N DIR,DIRUT,X,Y
S DIR(0)="Y"
S DIR("A")="Are you sure that you want to edit the patient's security level"
S DIR("B")="NO"
D ^DIR
Q:$D(DIRUT) 0
Q Y
;
DTR ;-- get date range
S %DT("A")="Begin Date: ",%DT="AEPX" W ! D ^%DT
I Y=-1 K BDGSD G ASKPUR
S BDGSD=Y X ^DD("DD") S BDGSDY=Y
ED S %DT("A")="End Date: " W ! D ^%DT K %DT
I Y=-1 K BDGED G DTR
S BDGED=Y X ^DD("DD") S BDGEDY=Y
I BDGED<BDGSD W !!,"Ending Date cannot be before Starting Date! Please reenter.",! G DTR
Q
;
DGSEC1 ;ALB/RMO-MAS Security Options ; [ 01/04/2002 7:06 AM ]
+1 ;;5.3;Registration;**222,149,214,1010,1015**;Aug 13, 1993;Build 21
+2 ;IHS/ANMC/LJF 9/06/2000 added IHS entry point for protocol
+3 ; 9/07/2000 added check to quit loop if called by protocol
+4 ; changed SSN to chart # in bulletin
+5 ; 9/08/2000 changed SSN to chart # in purge report
+6 ; 9/14/2000 commented out call to SECA08^VAFCDD01
+7 ; no need to update Pivot table
+8 ; 1/04/2002 using IHS template for editing
+9 ;
+10 ;cmi/anch/maw 05/03/2009 PATCH 1010 RQMT49 mods under subroutine 4
+11 ;
+12 NEW I,X,DIK
+13 IF $DATA(^DOPT("DGSEC1",4))
GOTO A
SET ^DOPT("DGSEC1",0)="Security Menu Options^1N^"
FOR I=1:1
SET X=$TEXT(@(I)+1)
IF X=""
QUIT
SET ^DOPT("DGSEC1",I,0)=$PIECE(X,";;",2,99)
+14 SET DIK="^DOPT(""DGSEC1"","
DO IXALL^DIK
A NEW DIC,Y,X
+1 WRITE !!
SET DIC="^DOPT(""DGSEC1"","
SET DIC(0)="AEQM"
DO ^DIC
IF Y<0
QUIT
DO @+Y
GOTO A
1 ;
+1 ;;Enter/Edit Patient Security Level
+2 ;IHS/ANMC/LJF 9/7/2000
IF $GET(BDGSECL)
KILL BDGSECL
DO Q
QUIT
+3 NEW DA,DLAYGO,DR,DIC,X,Y
+4 IF '$DATA(^XUSEC("DG SENSITIVITY",DUZ))
WRITE !!?3,$CHAR(7),"You do not have the appropriate access privileges to assign security."
QUIT
+5 SET DIC("A")="Select PATIENT NAME: "
SET DIC="^DGSL(38.1,"
SET DLAYGO=38.1
SET DIC(0)="AELMQ"
SET DGSENFLG=""
WRITE !
DO ^DIC
KILL DIC("A"),DGSENFLG
IF Y<0
QUIT
+6 SET DA=+Y
+7 ;
IHS ;EP; -- entry point from IHS protocol;IHS/ANMC/LJF 9/6/2000
+1 ;IHS/ANMC/LJF 1/04/2002
SET DIE="^DGSL(38.1,"
SET DR="[BDG ENTER/EDIT SECURITY]"
DO ^DIE
KILL DIE,DA,DR
QUIT
+2 ;
+3 ; warn user if attempting to edit security level from remote source
+4 NEW SECSRCE,OK
+5 SET SECSRCE=$PIECE($GET(^DGSL(38.1,DA,0)),"^",5)
+6 IF SECSRCE'=""
Begin DoDot:1
+7 WRITE !!?3,$CHAR(7),">>> WARNING: The source that assigned this patient's security level"
+8 WRITE !,?16,"is '"_$SELECT(SECSRCE="AAC":"VBA",1:"UNKNOWN")_"'. Editing the patient security level will"
+9 WRITE !,?16,"cause the security source to be deleted.",!
+10 SET OK=$$RUSURE()
End DoDot:1
IF 'OK
GOTO 1
+11 ;
+12 NEW SENSBEF,SENSAFTR
+13 SET SENSBEF=$PIECE($GET(^DGSL(38.1,DA,0)),"^",2)
+14 SET DIE="^DGSL(38.1,"
+15 SET DR="2;3////"_DUZ_";4///NOW"
+16 IF SECSRCE'=""
IF $GET(OK)
SET DR=DR_";5////@"
+17 DO ^DIE
+18 KILL DE,DQ,DIE
+19 SET SENSAFTR=$PIECE($GET(^DGSL(38.1,DA,0)),"^",2)
+20 ;
+21 ;CIRN CHANGES
+22 ;I SENSBEF'=SENSAFTR D SECA08^VAFCDD01(DA) ;IHS/ANMC/LJF 9/14/2000
+23 KILL SENSBEF,SENSAFTR
+24 GOTO 1
+25 ;
BULTIN ;This bulletin is sent if a patient's sensitivity is removed.
+1 NEW SECSRCE,SUB,DIC,X,Y
SET SUB=1
+2 KILL DGB
IF $DATA(^DG(43,1,"NOT"))
IF +$PIECE(^("NOT"),"^",11)
SET DGB=11
+3 IF '$DATA(DGB)
QUIT
+4 SET DGB=+$PIECE($GET(^DG(43,1,"NOT")),U,DGB)
IF 'DGB
QUIT
+5 SET DGB=$PIECE($GET(^XMB(3.8,DGB,0)),U)
IF '$LENGTH(DGB)
QUIT
+6 NEW XMB,XMY,XMY0,XMZ,DGI
+7 SET XMB="DG SENSITIVITY REMOVED"
SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET XMB(7)=Y
+8 SET XMB(1)="UNKNOWN"
SET X=+$PIECE(^DGSL(38.1,DA,0),"^",3)
IF X
Begin DoDot:1
+9 SET DIC="^VA(200,"
SET DIC(0)="MO"
SET X="`"_X
DO ^DIC
+10 IF Y>0
SET XMB(1)=$PIECE(Y,U,2)
IF XMB(1)=""
SET XMB(1)="UNKNOWN"
+11 QUIT
End DoDot:1
+12 ;S XMB(2)=$S($D(^DPT(DA,0)):$P(^(0),"^")_" ("_$P(^(0),"^",9)_")",1:"UNKNOWN")
+13 ;IHS/ANMC/LJF 9/7/2000
SET XMB(2)=$$VAL^XBDIQ1(2,DA,.01)_" (#"_$$HRCN^BDGF2(DA,DUZ(2))_")"
+14 FOR DGI=3:1:6
SET XMB(DGI)=""
+15 SET SECSRCE=$PIECE($GET(^DGSL(38.1,DA,0)),"^",5)
IF SECSRCE'=""
Begin DoDot:1
+16 SET XMB(3)=" >>> WARNING: The source of the patient sensitivity"
+17 SET XMB(4)=" removed was "_$SELECT(SECSRCE="AAC":"VBA",1:"UNKNOWN")
End DoDot:1
+18 IF $DATA(^DGSL(38.1,DA,0))
IF '$ORDER(^("D",0))
Begin DoDot:1
+19 SET XMB(5)="No record of user access, patient should be removed"
+20 SET XMB(6)="from the security log."
End DoDot:1
+21 SET XMY("G."_DGB)=""
DO SEND^DGSEC(.XMB,.XMY)
+22 QUIT
2 ;
+1 ;;Display User Access to Patient Record
+2 GOTO ^DGSEC2
3 ;
+1 ;;Purge Record of User Access from Security Log
+2 GOTO ^DGSEC3
4 ;
+1 ;;Purge Non-sensitive Patients from Security Log
+2 IF '$DATA(^XUSEC("DG SECURITY OFFICER",DUZ))
WRITE !!?3,$CHAR(7),"You do not have the appropriate access privileges to purge patients."
QUIT
ASKPUR NEW %
+1 WRITE !!,"Are you sure you want to purge all non-sensitive patients"
SET %=2
DO YN^DICN
IF %<0!(%=2)
GOTO Q
+2 IF '%
WRITE !!,"Enter 'YES' to purge non-sensitive patients, or 'NO' to exit this process."
GOTO ASKPUR
+3 ;cmi/maw 5/3/2009 PATCH 1010 RQMT49
DO DTR
+4 IF '$GET(BDGSD)
GOTO Q
+5 ;
ASKPRT WRITE !!,"Do you want to print patients 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 patients being purged, or 'NO' to schedule purge."
GOTO ASKPRT
+1 SET DGPGM="PURNON^DGSEC1"
SET DGVAR="DGPRT^DUZ"
IF DGPRT=""
WRITE !
DO ZIS^DGUTQ
IF POP
GOTO Q
GOTO PURNON
+2 IF DGPRT="QUE"
SET ION=""
WRITE !
DO QUE^DGUTQ
GOTO Q
+3 ;
PURNON NEW DIC,Y
+1 IF DGPRT=""
SET DGCNT=0
WRITE !!,"Purge Non-sensitive Patients from Security Log started "
DO H^DGUTL
SET Y=DGTIME
DO DT^DIQ
WRITE ".",!
+2 ;F DFN=0:0 S DFN=$O(^DGSL(38.1,"ANS",DFN)) Q:'DFN I $D(^DGSL(38.1,DFN,0)),'$P(^(0),"^",2) S DA=DFN,DIK="^DGSL(38.1," D ^DIK I DGPRT="" W !," ...",$S($D(^DPT(DFN,0)):$P(^(0),"^")_" ("_$P(^(0),"^",9)_")",1:"Unknown") S DGCNT=DGCNT+1
+3 ;F DFN=0:0 S DFN=$O(^DGSL(38.1,"ANS",DFN)) Q:'DFN I $D(^DGSL(38.1,DFN,0)),'$P(^(0),"^",2) S DA=DFN,DIK="^DGSL(38.1," D ^DIK I DGPRT="" W !," ...",$S($D(^DPT(DFN,0)):$P(^(0),"^")_" ("_$$HRCN^BDGF2(DFN,DUZ(2))_")",1:"Unknown") S DGCNT=DGCNT+1
+4 ;cmi/maw 5/3/2009 PATCH 1010 RQMT49
FOR DFN=0:0
SET DFN=$ORDER(^DGSL(38.1,"ANS",DFN))
IF 'DFN
QUIT
IF $DATA(^DGSL(38.1,DFN,0))
IF '$PIECE(^(0),"^",2)
IF $PIECE($PIECE(^(0),"^",4),",")<BDGED
IF $PIECE($PIECE(^(0),"^",4),".")>BDGSD
SET DA=DFN
SET DIK="^DGSL(38.1,"
DO ^DIK
IF DGPRT=""
Begin DoDot:1
+5 ;IHS/ANMC/LJF 9/8/2000
WRITE !," ...",$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),"^")_" ("_$$HRCN^BDGF2(DFN,DUZ(2))_")",1:"Unknown")
SET DGCNT=DGCNT+1
End DoDot:1
+6 IF DGPRT=""
WRITE !!,"Purge completed "
DO H^DGUTL
SET Y=DGTIME
DO DT^DIQ
WRITE ". ","Number of records purged: ",DGCNT
+7 ;
Q KILL DFN,DGCNT,DGPGM,DGPRT,DGVAR,POP
DO CLOSE^DGUTQ
+1 QUIT
+2 ;
+3 ;
RUSURE() ; Description: Asks user if they are sure they want to edit the DG SECURITY LOG record.
+1 ;
+2 NEW DIR,DIRUT,X,Y
+3 SET DIR(0)="Y"
+4 SET DIR("A")="Are you sure that you want to edit the patient's security level"
+5 SET DIR("B")="NO"
+6 DO ^DIR
+7 IF $DATA(DIRUT)
QUIT 0
+8 QUIT Y
+9 ;
DTR ;-- get date range
+1 SET %DT("A")="Begin Date: "
SET %DT="AEPX"
WRITE !
DO ^%DT
+2 IF Y=-1
KILL BDGSD
GOTO ASKPUR
+3 SET BDGSD=Y
XECUTE ^DD("DD")
SET BDGSDY=Y
ED SET %DT("A")="End Date: "
WRITE !
DO ^%DT
KILL %DT
+1 IF Y=-1
KILL BDGED
GOTO DTR
+2 SET BDGED=Y
XECUTE ^DD("DD")
SET BDGEDY=Y
+3 IF BDGED<BDGSD
WRITE !!,"Ending Date cannot be before Starting Date! Please reenter.",!
GOTO DTR
+4 QUIT
+5 ;
