DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
;;5.3;Registration;**32,46,197,214,249,281,352,391,425,582,769,796,964,1130**;Aug 13, 1993;Build 7
;Per VHA Directive 6402, this routine should not be modified.
;
;Entry point from DPTLK
I +$G(Y)=+$G(^DISV(DUZ,"^DPT(")),$G(DPTBTDT) K DPTBTDT Q
N DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1
;Y=Patient file DFN
S DGY=Y
;OWNREC^DGSEC4 parameters:
; DGREC = output array passed by reference
; DGY = Patient file DFN
; DUZ = New Person file IEN
; 1=generate error msg
; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry
; DGPTSSN - set to patient's SSN when adding new Patient file entry
; X=Patient's SSN from DPTLK2
I $G(DGNEWPT)=1 S DGPTSSN=X
D OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
S Y=DGY
I DGREC(1)=1!(DGREC(1)=2) D G Q
.S Y=-1
.D DISP(.DGREC)
.I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
;SENS^DGSEC4 parameters:
; DGSENS = output array passed by reference
; Y = Patient fileDFN
; DUZ = New Person file IEN
; DDS - Screenman variable
; DGSENFLG - If defined, patient record sensitivity not checked
D SENS^DGSEC4(.DGSENS,+Y,DUZ,$G(DDS),.DGSENFLG)
;DUZ must be defined to access a sensitive record
I DGSENS(1)=-1 D G Q
.S Y=-1
.D DISP(.DGSENS)
I DGSENS(1)=0 D G Q
.;DG*5.3*964 hook to call VistA Security Remediation Audit solution VAS
.I $$GET1^DIQ(46.5,1,.02,"I") D SELAUD^DGAUDIT2(2,$G(DGY),"INQUIRY",$G(DGOPT))
;Get option name for DG Security Log file and bulletin
D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
I DGSENS(1)=1 D
.I DIC(0)["E" D
..W $C(7)
..D DISP(.DGSENS)
.I Y>0 D
..;Parameters: DFN,DUZ,,Option name^Menu text
..D SETLOG1(+Y,DUZ,,DGOPT)
I DGSENS(1)=2 D
.I DIC(0)["E" D
..W $C(7)
..D DISP2V
..D NOTCE1
.I Y>0 D
..D SETLOG1(+Y,DUZ,,DGOPT)
..;Parameters: DFN,DUZ,Option name^Menu text,message array
..D BULTIN1(+Y,DUZ,DGOPT,.DGMSG)
..I $D(DGSM),DIC(0)["E" D DISP(.DGMSG)
D Q
Q
;
REC ;DPTLK2 entry point when adding new Patient file record
;Input: X=Patient's SSN
;Output: DGREC=1 (adding own record or SSN not defined) or 0
;
;Parameters: DGREC=output array
; DUZ
; 1 - generate error msg
; DGNEWPT = 1 (adding new Patient (#2) file record
; DGPTSSN = X (Patient's SSN)
N DGPTSSN
S DGPTSSN=X
D OWNREC^DGSEC4(.DGREC,,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
I DGREC(1)=1!(DGREC(1)=2) D
.D DISP(.DGREC)
.I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
S DGREC=+DGREC(1)
I DGREC=2 S DGREC=1
Q
SETLOG ;Entry point for DBIA #2242
;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text
D SETLOG1(Y,DUZ,DG1,DGOPT)
D Q
Q
BULTIN ;Entry point for DBIA #2242
;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text
D BULTIN1(Y,DUZ,DGOPT)
Q
SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1)
;Input:
; DFN - Patient (#2) file DFN (Required)
; DGDUZ - New Person (#200) file IEN
; DG1 - Inpatient or Outpatient (Optional)
; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional)
;
N DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT
;DG/582
I $G(VALM("TITLE"))="Dependents Module" Q
;Lock global
LOCK L +^DGSL(38.1,+DFN):1 G:'$T LOCK
;Add new entry for patient if not found
I '$D(^DGSL(38.1,+DFN,0)) D
.S ^DGSL(38.1,+DFN,0)=+DFN
.S ^DGSL(38.1,"B",+DFN,+DFN)=""
.S $P(^DGSL(38.1,0),U,3)=+DFN
.S $P(^DGSL(38.1,0),U,4)=$P(^DGSL(38.1,0),U,4)+1
.;Determine if entry is automatically sensitive
.N ELIG,FLAG,X
.S FLAG=0
.S X=$S($D(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"")
.I $D(^DG(391,+X,0)),$P(^(0),"^",4) S FLAG=1
.I 'FLAG S ELIG=0 F S ELIG=$O(^DPT(+DFN,"E",ELIG)) Q:'ELIG D Q:FLAG
..S X=$G(^DIC(8,ELIG,0))
..I $P(X,"^",12) S FLAG=1
.S $P(^DGSL(38.1,+DFN,0),"^",2)=FLAG
.;Date/time sensitivity was set
.S $P(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT()
;determine if an inpatient
D H^DGUTL
S DGT=DGTIME
I $G(DG1)="" D ^DGPMSTAT
;get option name
I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
SETUSR S DGDTE=9999999.9999-DGTIME I $D(^DGSL(38.1,+DFN,"D",DGDTE,0)) S DGTIME=DGTIME+.00001 G SETUSR
S:'$D(^DGSL(38.1,+DFN,"D",0)) ^(0)="^38.11DA^^" S ^DGSL(38.1,+DFN,"D",DGDTE,0)=DGTIME_U_DGDUZ_U_$P(DGOPT,U,2)_U_$S(DG1:"y",1:"n"),$P(^(0),U,3,4)=DGDTE_U_($P(^DGSL(38.1,+DFN,"D",0),U,4)+1)
S ^DGSL(38.1,"AD",DGDTE,+DFN)=""
S ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)=""
L -^DGSL(38.1,+DFN)
;
I $$GET1^DIQ(46.5,1,.02,"I") D SELAUD^DGAUDIT2(2,$G(DFN),"INQUIRY",$G(DGOPT))
;
Q
Q K DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT
N DGTEST S DGTEST=^%ZOSF("TEST")
I DIC(0)["E",Y>0 D
.S X="DGPFAPI" X DGTEST I $T D ;Patient Record Flags check/display
..N DGPFSAVY S DGPFSAVY=Y
..D DISPPRF^DGPFAPI(Y) S Y=DGPFSAVY K DGPFSAVY
.S X="A7RDPACT" X DGTEST I $T D ^A7RDPACT ;NDBI
.S X="GMRPNCW" X DGTEST I $T S DPTSAVY=Y D ENPAT^GMRPNCW S Y=DPTSAVY K DPTSAVY ; CWAD
.S X="MPRCHK" X DGTEST I $T D EN^MPRCHK(Y) ; MPR
Q
;
BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin
;
;Input: DFN = Patient file IEN
; DGDUZ = New Person (#200) file IEN
; DGOPT = Option (#19) file Name (#.01)^Menu text
; DGMSG = Message array (Optional)
;
N DGEMPLEE,XMSUB,XQOPT
;DG/582
I $G(VALM("TITLE"))="Dependents Module" Q
K DGB I $D(^DG(43,1,"NOT")),+$P(^("NOT"),U,10) S DGB=10
Q:'$D(DGB) S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
S DGB=+$P($G(^DG(43,1,"NOT")),U,DGB) Q:'DGB
S DGB=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR") Q:'$L(DGB)
;S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB)
I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
N XMB,XMY,XMY0,XMZ
S XMB="DG SENSITIVITY",XMB(1)=$P(^DPT(+DFN,0),U)
S DGEMPLEE=$$EMPL^DGSEC4(+DFN)
I DGEMPLEE=1 S XMB(1)=XMB(1)_" (Employee)"
S XMB(2)=$P(^DPT(+DFN,0),U,9),XMB(3)=$P(DGOPT,U,2),XMY("G."_DGB)=""
N Y S Y=$$NOW^XLFDT() X ^DD("DD") S XMB(4)=Y
D SEND(.XMB,.XMY)
S DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer."
Q
;
SEND(XMB,XMY) ;Queue mail bulletin
;Input: XMB,XMY=Mailman bulletin parameters
;
D ^XMB
Q
;
DISP(ARRAY) ;Display message text to screen
;Input: Array containg message text
;
I '$D(ARRAY) Q
I DIC(0)'["E" Q
I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY S X=0 X ^%ZOSF("RM")
N DGI,DGWHERE
I '$D(DDS) W !!
F DGI=1:0 S DGI=$O(ARRAY(DGI)) Q:'DGI D
.W ARRAY(DGI),!
Q
;
NOTCE1 W:'$D(DDS) ! W "Do you want to continue accessing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D W:'$D(DDS) !! W "Enter 'YES' to continue accessing, or 'NO' to quit accessing this record." W:$D(DDS) ! G NOTCE1
.I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY
Q
;
LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array
;PDX plans to use this - remember to NEW DIC before ^XMD call
; Input - None
; Output - XMY("G.mailgroupname")="" if field #509 is defined
; where mailgroupname is text value of mail group
; Returns: 0 - Ok
; -1^errortext - if can't find mail group
;
N DGB,DGERR,DGM
S DGERR=0
S DGB=+$P($G(^DG(43,1,"NOT")),"^",10)
S DGM=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR")
I '$D(DGM) S DGERR="-1^No/Bad Field #509 entry in File #43" G QTLOADX
S XMY("G."_DGM)="" ; pass mailgroup
QTLOADX Q DGERR
;
DISP2V ;Display message text to screen for Vista
N DGLNE
S DGSENS(1)=1
S DGSENS(2)=" ***WARNING*** "
S DGSENS(3)=" ***RESTRICTED RECORD*** "
S $P(DGLNE,"* ",40)=""
S DGSENS(4)=DGLNE
S DGSENS(5)="* 1. STOP *"
S DGSENS(6)="* 2. Confirm you need access to this Restricted patient record *"
S DGSENS(7)="* *"
S DGSENS(8)="* This record is protected by the Privacy Act of 1974 and the Health *"
S DGSENS(9)="* Insurance Portability and Accountability Act (HIPAA) Privacy Rule. *"
S DGSENS(10)="* * Access to this patient record is tracked and monitored. *"
S DGSENS(11)="* * You must have need for this record to accomplish officially *"
S DGSENS(12)="* authorized and assigned duties, such as direct patient care, to *"
S DGSENS(13)="* proceed. *"
S DGSENS(14)="* * You must provide justification for your access upon request. *"
S DGSENS(15)="* * Failure to comply may result in disciplinary or adverse action up to *"
S DGSENS(16)="* and including removal from Federal service, and civil and criminal *"
S DGSENS(17)="* penalties. *"
I $G(DDS)="" S DGSENS(18)=DGLNE
D DISP(.DGSENS)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGSEC 9221 printed Dec 13, 2024@02:58:53 Page 2
DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
+1 ;;5.3;Registration;**32,46,197,214,249,281,352,391,425,582,769,796,964,1130**;Aug 13, 1993;Build 7
+2 ;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Entry point from DPTLK
+5 IF +$GET(Y)=+$GET(^DISV(DUZ,"^DPT("))
IF $GET(DPTBTDT)
KILL DPTBTDT
QUIT
+6 NEW DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1
+7 ;Y=Patient file DFN
+8 SET DGY=Y
+9 ;OWNREC^DGSEC4 parameters:
+10 ; DGREC = output array passed by reference
+11 ; DGY = Patient file DFN
+12 ; DUZ = New Person file IEN
+13 ; 1=generate error msg
+14 ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry
+15 ; DGPTSSN - set to patient's SSN when adding new Patient file entry
+16 ; X=Patient's SSN from DPTLK2
+17 IF $GET(DGNEWPT)=1
SET DGPTSSN=X
+18 DO OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$GET(DGNEWPT),$GET(DGPTSSN))
+19 SET Y=DGY
+20 IF DGREC(1)=1!(DGREC(1)=2)
Begin DoDot:1
+21 SET Y=-1
+22 DO DISP(.DGREC)
+23 IF $DATA(DDS)
READ !,"Please enter any key to continue.",DGANS:DTIME
End DoDot:1
GOTO Q
+24 ;SENS^DGSEC4 parameters:
+25 ; DGSENS = output array passed by reference
+26 ; Y = Patient fileDFN
+27 ; DUZ = New Person file IEN
+28 ; DDS - Screenman variable
+29 ; DGSENFLG - If defined, patient record sensitivity not checked
+30 DO SENS^DGSEC4(.DGSENS,+Y,DUZ,$GET(DDS),.DGSENFLG)
+31 ;DUZ must be defined to access a sensitive record
+32 IF DGSENS(1)=-1
Begin DoDot:1
+33 SET Y=-1
+34 DO DISP(.DGSENS)
End DoDot:1
GOTO Q
+35 IF DGSENS(1)=0
Begin DoDot:1
+36 ;DG*5.3*964 hook to call VistA Security Remediation Audit solution VAS
+37 IF $$GET1^DIQ(46.5,1,.02,"I")
DO SELAUD^DGAUDIT2(2,$GET(DGY),"INQUIRY",$GET(DGOPT))
End DoDot:1
GOTO Q
+38 ;Get option name for DG Security Log file and bulletin
+39 DO OP^XQCHK
SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
+40 IF DGSENS(1)=1
Begin DoDot:1
+41 IF DIC(0)["E"
Begin DoDot:2
+42 WRITE $CHAR(7)
+43 DO DISP(.DGSENS)
End DoDot:2
+44 IF Y>0
Begin DoDot:2
+45 ;Parameters: DFN,DUZ,,Option name^Menu text
+46 DO SETLOG1(+Y,DUZ,,DGOPT)
End DoDot:2
End DoDot:1
+47 IF DGSENS(1)=2
Begin DoDot:1
+48 IF DIC(0)["E"
Begin DoDot:2
+49 WRITE $CHAR(7)
+50 DO DISP2V
+51 DO NOTCE1
End DoDot:2
+52 IF Y>0
Begin DoDot:2
+53 DO SETLOG1(+Y,DUZ,,DGOPT)
+54 ;Parameters: DFN,DUZ,Option name^Menu text,message array
+55 DO BULTIN1(+Y,DUZ,DGOPT,.DGMSG)
+56 IF $DATA(DGSM)
IF DIC(0)["E"
DO DISP(.DGMSG)
End DoDot:2
End DoDot:1
+57 DO Q
+58 QUIT
+59 ;
REC ;DPTLK2 entry point when adding new Patient file record
+1 ;Input: X=Patient's SSN
+2 ;Output: DGREC=1 (adding own record or SSN not defined) or 0
+3 ;
+4 ;Parameters: DGREC=output array
+5 ; DUZ
+6 ; 1 - generate error msg
+7 ; DGNEWPT = 1 (adding new Patient (#2) file record
+8 ; DGPTSSN = X (Patient's SSN)
+9 NEW DGPTSSN
+10 SET DGPTSSN=X
+11 DO OWNREC^DGSEC4(.DGREC,,DUZ,1,$GET(DGNEWPT),$GET(DGPTSSN))
+12 IF DGREC(1)=1!(DGREC(1)=2)
Begin DoDot:1
+13 DO DISP(.DGREC)
+14 IF $DATA(DDS)
READ !,"Please enter any key to continue.",DGANS:DTIME
End DoDot:1
+15 SET DGREC=+DGREC(1)
+16 IF DGREC=2
SET DGREC=1
+17 QUIT
SETLOG ;Entry point for DBIA #2242
+1 ;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text
+2 DO SETLOG1(Y,DUZ,DG1,DGOPT)
+3 DO Q
+4 QUIT
BULTIN ;Entry point for DBIA #2242
+1 ;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text
+2 DO BULTIN1(Y,DUZ,DGOPT)
+3 QUIT
SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1)
+1 ;Input:
+2 ; DFN - Patient (#2) file DFN (Required)
+3 ; DGDUZ - New Person (#200) file IEN
+4 ; DG1 - Inpatient or Outpatient (Optional)
+5 ; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional)
+6 ;
+7 NEW DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT
+8 ;DG/582
+9 IF $GET(VALM("TITLE"))="Dependents Module"
QUIT
+10 ;Lock global
LOCK LOCK +^DGSL(38.1,+DFN):1
if '$TEST
GOTO LOCK
+1 ;Add new entry for patient if not found
+2 IF '$DATA(^DGSL(38.1,+DFN,0))
Begin DoDot:1
+3 SET ^DGSL(38.1,+DFN,0)=+DFN
+4 SET ^DGSL(38.1,"B",+DFN,+DFN)=""
+5 SET $PIECE(^DGSL(38.1,0),U,3)=+DFN
+6 SET $PIECE(^DGSL(38.1,0),U,4)=$PIECE(^DGSL(38.1,0),U,4)+1
+7 ;Determine if entry is automatically sensitive
+8 NEW ELIG,FLAG,X
+9 SET FLAG=0
+10 SET X=$SELECT($DATA(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"")
+11 IF $DATA(^DG(391,+X,0))
IF $PIECE(^(0),"^",4)
SET FLAG=1
+12 IF 'FLAG
SET ELIG=0
FOR
SET ELIG=$ORDER(^DPT(+DFN,"E",ELIG))
if 'ELIG
QUIT
Begin DoDot:2
+13 SET X=$GET(^DIC(8,ELIG,0))
+14 IF $PIECE(X,"^",12)
SET FLAG=1
End DoDot:2
if FLAG
QUIT
+15 SET $PIECE(^DGSL(38.1,+DFN,0),"^",2)=FLAG
+16 ;Date/time sensitivity was set
+17 SET $PIECE(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT()
End DoDot:1
+18 ;determine if an inpatient
+19 DO H^DGUTL
+20 SET DGT=DGTIME
+21 IF $GET(DG1)=""
DO ^DGPMSTAT
+22 ;get option name
+23 IF $GET(DGOPT)=""
DO OP^XQCHK
SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
SETUSR SET DGDTE=9999999.9999-DGTIME
IF $DATA(^DGSL(38.1,+DFN,"D",DGDTE,0))
SET DGTIME=DGTIME+.00001
GOTO SETUSR
+1 if '$DATA(^DGSL(38.1,+DFN,"D",0))
SET ^(0)="^38.11DA^^"
SET ^DGSL(38.1,+DFN,"D",DGDTE,0)=DGTIME_U_DGDUZ_U_$PIECE(DGOPT,U,2)_U_$SELECT(DG1:"y",1:"n")
SET $PIECE(^(0),U,3,4)=DGDTE_U_($PIECE(^DGSL(38.1,+DFN,"D",0),U,4)+1)
+2 SET ^DGSL(38.1,"AD",DGDTE,+DFN)=""
+3 SET ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)=""
+4 LOCK -^DGSL(38.1,+DFN)
+5 ;
+6 IF $$GET1^DIQ(46.5,1,.02,"I")
DO SELAUD^DGAUDIT2(2,$GET(DFN),"INQUIRY",$GET(DGOPT))
+7 ;
+8 QUIT
Q KILL DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT
+1 NEW DGTEST
SET DGTEST=^%ZOSF("TEST")
+2 IF DIC(0)["E"
IF Y>0
Begin DoDot:1
+3 ;Patient Record Flags check/display
SET X="DGPFAPI"
XECUTE DGTEST
IF $TEST
Begin DoDot:2
+4 NEW DGPFSAVY
SET DGPFSAVY=Y
+5 DO DISPPRF^DGPFAPI(Y)
SET Y=DGPFSAVY
KILL DGPFSAVY
End DoDot:2
+6 ;NDBI
SET X="A7RDPACT"
XECUTE DGTEST
IF $TEST
DO ^A7RDPACT
+7 ; CWAD
SET X="GMRPNCW"
XECUTE DGTEST
IF $TEST
SET DPTSAVY=Y
DO ENPAT^GMRPNCW
SET Y=DPTSAVY
KILL DPTSAVY
+8 ; MPR
SET X="MPRCHK"
XECUTE DGTEST
IF $TEST
DO EN^MPRCHK(Y)
End DoDot:1
+9 QUIT
+10 ;
BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin
+1 ;
+2 ;Input: DFN = Patient file IEN
+3 ; DGDUZ = New Person (#200) file IEN
+4 ; DGOPT = Option (#19) file Name (#.01)^Menu text
+5 ; DGMSG = Message array (Optional)
+6 ;
+7 NEW DGEMPLEE,XMSUB,XQOPT
+8 ;DG/582
+9 IF $GET(VALM("TITLE"))="Dependents Module"
QUIT
+10 KILL DGB
IF $DATA(^DG(43,1,"NOT"))
IF +$PIECE(^("NOT"),U,10)
SET DGB=10
+11 if '$DATA(DGB)
QUIT
SET XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
+12 SET DGB=+$PIECE($GET(^DG(43,1,"NOT")),U,DGB)
if 'DGB
QUIT
+13 SET DGB=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR")
if '$LENGTH(DGB)
QUIT
+14 ;S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB)
+15 IF $GET(DGOPT)=""
DO OP^XQCHK
SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
+16 NEW XMB,XMY,XMY0,XMZ
+17 SET XMB="DG SENSITIVITY"
SET XMB(1)=$PIECE(^DPT(+DFN,0),U)
+18 SET DGEMPLEE=$$EMPL^DGSEC4(+DFN)
+19 IF DGEMPLEE=1
SET XMB(1)=XMB(1)_" (Employee)"
+20 SET XMB(2)=$PIECE(^DPT(+DFN,0),U,9)
SET XMB(3)=$PIECE(DGOPT,U,2)
SET XMY("G."_DGB)=""
+21 NEW Y
SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET XMB(4)=Y
+22 DO SEND(.XMB,.XMY)
+23 SET DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer."
+24 QUIT
+25 ;
SEND(XMB,XMY) ;Queue mail bulletin
+1 ;Input: XMB,XMY=Mailman bulletin parameters
+2 ;
+3 DO ^XMB
+4 QUIT
+5 ;
DISP(ARRAY) ;Display message text to screen
+1 ;Input: Array containg message text
+2 ;
+3 IF '$DATA(ARRAY)
QUIT
+4 IF DIC(0)'["E"
QUIT
+5 IF $DATA(DDS)
DO CLRMSG^DDS
SET DX=0
SET DY=DDSHBX+1
XECUTE DDXY
SET X=0
XECUTE ^%ZOSF("RM")
+6 NEW DGI,DGWHERE
+7 IF '$DATA(DDS)
WRITE !!
+8 FOR DGI=1:0
SET DGI=$ORDER(ARRAY(DGI))
if 'DGI
QUIT
Begin DoDot:1
+9 WRITE ARRAY(DGI),!
End DoDot:1
+10 QUIT
+11 ;
NOTCE1 if '$DATA(DDS)
WRITE !
WRITE "Do you want to continue accessing this patient record"
SET %=2
DO YN^DICN
if %<0!(%=2)
SET Y=-1
IF '%
Begin DoDot:1
+1 IF $DATA(DDS)
DO CLRMSG^DDS
SET DX=0
SET DY=DDSHBX+1
XECUTE DDXY
End DoDot:1
if '$DATA(DDS)
WRITE !!
WRITE "Enter 'YES' to continue accessing, or 'NO' to quit accessing this record."
if $DATA(DDS)
WRITE !
GOTO NOTCE1
+2 QUIT
+3 ;
LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array
+1 ;PDX plans to use this - remember to NEW DIC before ^XMD call
+2 ; Input - None
+3 ; Output - XMY("G.mailgroupname")="" if field #509 is defined
+4 ; where mailgroupname is text value of mail group
+5 ; Returns: 0 - Ok
+6 ; -1^errortext - if can't find mail group
+7 ;
+8 NEW DGB,DGERR,DGM
+9 SET DGERR=0
+10 SET DGB=+$PIECE($GET(^DG(43,1,"NOT")),"^",10)
+11 SET DGM=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR")
+12 IF '$DATA(DGM)
SET DGERR="-1^No/Bad Field #509 entry in File #43"
GOTO QTLOADX
+13 ; pass mailgroup
SET XMY("G."_DGM)=""
QTLOADX QUIT DGERR
+1 ;
DISP2V ;Display message text to screen for Vista
+1 NEW DGLNE
+2 SET DGSENS(1)=1
+3 SET DGSENS(2)=" ***WARNING*** "
+4 SET DGSENS(3)=" ***RESTRICTED RECORD*** "
+5 SET $PIECE(DGLNE,"* ",40)=""
+6 SET DGSENS(4)=DGLNE
+7 SET DGSENS(5)="* 1. STOP *"
+8 SET DGSENS(6)="* 2. Confirm you need access to this Restricted patient record *"
+9 SET DGSENS(7)="* *"
+10 SET DGSENS(8)="* This record is protected by the Privacy Act of 1974 and the Health *"
+11 SET DGSENS(9)="* Insurance Portability and Accountability Act (HIPAA) Privacy Rule. *"
+12 SET DGSENS(10)="* * Access to this patient record is tracked and monitored. *"
+13 SET DGSENS(11)="* * You must have need for this record to accomplish officially *"
+14 SET DGSENS(12)="* authorized and assigned duties, such as direct patient care, to *"
+15 SET DGSENS(13)="* proceed. *"
+16 SET DGSENS(14)="* * You must provide justification for your access upon request. *"
+17 SET DGSENS(15)="* * Failure to comply may result in disciplinary or adverse action up to *"
+18 SET DGSENS(16)="* and including removal from Federal service, and civil and criminal *"
+19 SET DGSENS(17)="* penalties. *"
+20 IF $GET(DDS)=""
SET DGSENS(18)=DGLNE
+21 DO DISP(.DGSENS)
+22 QUIT
