Routine: DGSEC1

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)

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

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  Feb 19, 2025@00:24:55                                                                                                                                                                                                      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

DGSEC1.m