DGSEC1 ;ALB/RMO-MAS Security Options ;7/24/99 23:48
;;5.3;Registration;**222,149,214**;Aug 13, 1993
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
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
;
; 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)
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")
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
;
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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGSEC1 4172 printed Dec 13, 2024@02:58:53 Page 2
DGSEC1 ;ALB/RMO-MAS Security Options ;7/24/99 23:48
+1 ;;5.3;Registration;**222,149,214**;Aug 13, 1993
+2 NEW I,X,DIK
+3 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)
+4 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 NEW DA,DLAYGO,DR,DIC,X,Y
+3 IF '$DATA(^XUSEC("DG SENSITIVITY",DUZ))
WRITE !!?3,$CHAR(7),"You do not have the appropriate access privileges to assign security."
QUIT
+4 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
+5 SET DA=+Y
+6 ;
+7 ; warn user if attempting to edit security level from remote source
+8 NEW SECSRCE,OK
+9 SET SECSRCE=$PIECE($GET(^DGSL(38.1,DA,0)),"^",5)
+10 IF SECSRCE'=""
Begin DoDot:1
+11 WRITE !!?3,$CHAR(7),">>> WARNING: The source that assigned this patient's security level"
+12 WRITE !,?16,"is '"_$SELECT(SECSRCE="AAC":"VBA",1:"UNKNOWN")_"'. Editing the patient security level will"
+13 WRITE !,?16,"cause the security source to be deleted.",!
+14 SET OK=$$RUSURE()
End DoDot:1
if 'OK
GOTO 1
+15 ;
+16 NEW SENSBEF,SENSAFTR
+17 SET SENSBEF=$PIECE($GET(^DGSL(38.1,DA,0)),"^",2)
+18 SET DIE="^DGSL(38.1,"
+19 SET DR="2;3////"_DUZ_";4///NOW"
+20 IF SECSRCE'=""
IF $GET(OK)
SET DR=DR_";5////@"
+21 DO ^DIE
+22 KILL DE,DQ,DIE
+23 SET SENSAFTR=$PIECE($GET(^DGSL(38.1,DA,0)),"^",2)
+24 ;
+25 ;CIRN CHANGES
+26 IF SENSBEF'=SENSAFTR
DO SECA08^VAFCDD01(DA)
+27 KILL SENSBEF,SENSAFTR
+28 GOTO 1
+29 ;
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 SET XMB(2)=$SELECT($DATA(^DPT(DA,0)):$PIECE(^(0),"^")_" ("_$PIECE(^(0),"^",9)_")",1:"UNKNOWN")
+13 FOR DGI=3:1:6
SET XMB(DGI)=""
+14 SET SECSRCE=$PIECE($GET(^DGSL(38.1,DA,0)),"^",5)
IF SECSRCE'=""
Begin DoDot:1
+15 SET XMB(3)=" >>> WARNING: The source of the patient sensitivity"
+16 SET XMB(4)=" removed was "_$SELECT(SECSRCE="AAC":"VBA",1:"UNKNOWN")
End DoDot:1
+17 IF $DATA(^DGSL(38.1,DA,0))
IF '$ORDER(^("D",0))
Begin DoDot:1
+18 SET XMB(5)="No record of user access, patient should be removed"
+19 SET XMB(6)="from the security log."
End DoDot:1
+20 SET XMY("G."_DGB)=""
DO SEND^DGSEC(.XMB,.XMY)
+21 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 ;
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 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)
SET DA=DFN
SET DIK="^DGSL(38.1,"
DO ^DIK
IF DGPRT=""
WRITE !," ...",$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),"^")_" ("_$PIECE(^(0),"^",9)_")",1:"Unknown")
SET DGCNT=DGCNT+1
+3 IF DGPRT=""
WRITE !!,"Purge completed "
DO H^DGUTL
SET Y=DGTIME
DO DT^DIQ
WRITE ". ","Number of records purged: ",DGCNT
+4 ;
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
