BDGSECU.m

BDGSECU ; IHS/ANMC/LJF - UPDATE SECURITY PARAMETERS ; 

 ;;5.3;PIMS;**1004**;MAY 28, 2004

 ;IHS/OIT/LJF 11/03/2005 PATCH 1004 moved message subroutine to IHS routine

 ;

CHOOSE ; ask user to choose function to perform

 NEW BDGA,Y

 S BDGA(1)=$$SP(10)_"1. Edit Security Parameters"

 S BDGA(2)=$$SP(10)_"2. Edit Mail Group Members"

 S BDGA(3)=$$SP(10)_"3. List Security Key Holders"

 S BDGA(4)=""

 S Y=$$READ^BDGF("NO^1:3","  Select Action","","","",.BDGA)

 Q:'Y  D @Y

 Q

 ;

1 ; -- call screenman to edit parameters

 NEW DA,DIC,DDR,DLAYGO,BDGERR

 ;

 ;  if no entry in MAS Parameters file, add one

 I '$D(^DG(43,1,0)) D  I $G(BDGERR) D MSG^BDGF(BDGERR) Q

 . K DD,DO S (DIC,DLAYGO)=43,DIC(0)="L"

 . S (X,DINUM)=1 D FILE^DICN

 . I Y=-1 S BDGERR="Adding to MAS Parameter file failed; contact supervisor."

 ;

 ; -- call ScreenMan to add/edit parameters

 S DDSFILE=43,DA=1,DR="[BDG SECURITY PARAMETERS]" D ^DDS

 K DDSFILE,DR

 Q

 ;

 ;

2 ; -- call screenman to edit mail group members

 ;NEW DA,DIC,DDR,DLAYGO

 ;

 S X=$O(^XMB(3.8,"B","DG MISSING NEW PERSON SSN",0))  ;mailgroup ien

 I 'X D  Q   ;mail group gone

 . D MSG^BDGF("Mail Group DG MISSING NEW PERSON SSN not in file",2,0)

 . D MSG^BDGF("Contact ITSC Help Desk for assistance",1,1)

 . D PAUSE^BDGF

 ;

 I '$O(^XMB(3.8,X,1,0)) D  ;no members in mail group

 . D MSG^BDGF("Don't forget to add members to DG MISSING NEW PERSON SSN mail group",2,0)

 ;

 ; ask user to select a mail group; screen by coordinator

 S (DIC,DLAYGO)=3.8,DIC(0)="AEMQZL"

 S DIC("S")="I ($D(^XUSEC(""XMMGR"",DUZ)))!($P($G(^XMB(3.8,+Y,0)),U,7)=DUZ)"

 S DIC("DR")="4///PU;10///0;7///n"

 W !! D ^DIC Q:Y<1

 ;

 ; -- call ScreenMan to add/edit parameters

 S DDSFILE=3.8,DA=+Y,DR="[BDG SECURITY MAIL GROUP EDIT]" D ^DDS

 K DDSFILE,DR

 Q

 ;

3 ; -- list holders of module's security keys

 D ^BDGSECU1

 Q

 ;

PAD(D,L) ;EP -- SUBRTN to pad length of data

 ; -- D=data L=length

 Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)

 ;

SP(N) ; -- SUBRTN to pad N number of spaces

 Q $$PAD(" ",N)

 ;

 ;

 ;IHS/OIT/LJF 11/03/2005 PATCH 1004 added new subroutine

MSG ;EP - Warning message on sensitive patients

 ; called by PRIV^DGSEC4

 S DGSENS(5)="* This record is protected by the Privacy Act of 1974 & Health Insurance*"

 S DGSENS(6)="* Portability & Accountability Act of 1996. If you elect to proceed, you*"

 S DGSENS(7)="* must prove you have a need to know.  Access to this patient is tracked*"

 S DGSENS(8)="* and your Security Officer will contact you for your justification.    *"

 Q

BDGSECU   ; IHS/ANMC/LJF - UPDATE SECURITY PARAMETERS ; 

 +1       ;;5.3;PIMS;**1004**;MAY 28, 2004

 +2       ;IHS/OIT/LJF 11/03/2005 PATCH 1004 moved message subroutine to IHS routine

 +3       ;

CHOOSE    ; ask user to choose function to perform

 +1        NEW BDGA,Y

 +2        SET BDGA(1)=$$SP(10)_"1. Edit Security Parameters"

 +3        SET BDGA(2)=$$SP(10)_"2. Edit Mail Group Members"

 +4        SET BDGA(3)=$$SP(10)_"3. List Security Key Holders"

 +5        SET BDGA(4)=""

 +6        SET Y=$$READ^BDGF("NO^1:3","  Select Action","","","",.BDGA)

 +7        IF 'Y

               QUIT 

           DO @Y

 +8        QUIT 

 +9       ;

1         ; -- call screenman to edit parameters

 +1        NEW DA,DIC,DDR,DLAYGO,BDGERR

 +2       ;

 +3       ;  if no entry in MAS Parameters file, add one

 +4        IF '$DATA(^DG(43,1,0))

               Begin DoDot:1

 +5                KILL DD,DO

                   SET (DIC,DLAYGO)=43

                   SET DIC(0)="L"

 +6                SET (X,DINUM)=1

                   DO FILE^DICN

 +7                IF Y=-1

                       SET BDGERR="Adding to MAS Parameter file failed; contact supervisor."

               End DoDot:1

               IF $GET(BDGERR)

                   DO MSG^BDGF(BDGERR)

                   QUIT 

 +8       ;

 +9       ; -- call ScreenMan to add/edit parameters

 +10       SET DDSFILE=43

           SET DA=1

           SET DR="[BDG SECURITY PARAMETERS]"

           DO ^DDS

 +11       KILL DDSFILE,DR

 +12       QUIT 

 +13      ;

 +14      ;

2         ; -- call screenman to edit mail group members

 +1       ;NEW DA,DIC,DDR,DLAYGO

 +2       ;

 +3       ;mailgroup ien

           SET X=$ORDER(^XMB(3.8,"B","DG MISSING NEW PERSON SSN",0))

 +4       ;mail group gone

           IF 'X

               Begin DoDot:1

 +5                DO MSG^BDGF("Mail Group DG MISSING NEW PERSON SSN not in file",2,0)

 +6                DO MSG^BDGF("Contact ITSC Help Desk for assistance",1,1)

 +7                DO PAUSE^BDGF

               End DoDot:1

               QUIT 

 +8       ;

 +9       ;no members in mail group

           IF '$ORDER(^XMB(3.8,X,1,0))

               Begin DoDot:1

 +10               DO MSG^BDGF("Don't forget to add members to DG MISSING NEW PERSON SSN mail group",2,0)

               End DoDot:1

 +11      ;

 +12      ; ask user to select a mail group; screen by coordinator

 +13       SET (DIC,DLAYGO)=3.8

           SET DIC(0)="AEMQZL"

 +14       SET DIC("S")="I ($D(^XUSEC(""XMMGR"",DUZ)))!($P($G(^XMB(3.8,+Y,0)),U,7)=DUZ)"

 +15       SET DIC("DR")="4///PU;10///0;7///n"

 +16       WRITE !!

           DO ^DIC

           IF Y<1

               QUIT 

 +17      ;

 +18      ; -- call ScreenMan to add/edit parameters

 +19       SET DDSFILE=3.8

           SET DA=+Y

           SET DR="[BDG SECURITY MAIL GROUP EDIT]"

           DO ^DDS

 +20       KILL DDSFILE,DR

 +21       QUIT 

 +22      ;

3         ; -- list holders of module's security keys

 +1        DO ^BDGSECU1

 +2        QUIT 

 +3       ;

PAD(D,L)  ;EP -- SUBRTN to pad length of data

 +1       ; -- D=data L=length

 +2        QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)

 +3       ;

SP(N)     ; -- SUBRTN to pad N number of spaces

 +1        QUIT $$PAD(" ",N)

 +2       ;

 +3       ;

 +4       ;IHS/OIT/LJF 11/03/2005 PATCH 1004 added new subroutine

MSG       ;EP - Warning message on sensitive patients

 +1       ; called by PRIV^DGSEC4

 +2        SET DGSENS(5)="* This record is protected by the Privacy Act of 1974 & Health Insurance*"

 +3        SET DGSENS(6)="* Portability & Accountability Act of 1996. If you elect to proceed, you*"

 +4        SET DGSENS(7)="* must prove you have a need to know.  Access to this patient is tracked*"

 +5        SET DGSENS(8)="* and your Security Officer will contact you for your justification.    *"

 +6        QUIT