DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
;;5.3;PIMS;**32,46,197,214,249,281,352,391,425,582,1002,1008,1009,1011,1015,1016**;JUN 30, 2012;Build 20
;IHS/ANMC/LJF 9/7/2000 added chart # to bulletin
; 8/31/2001 added code to track all patients per parameter
; 10/02/2003 VA added code to add patient but not setting of ANS xref
;IHS/ITSC/WAR 3/17/2005 Fix dealing with calls from other apps/pkgs
;IHS/OIT/LJF 08/31/2007 PATCH 1008 added code to check if user is restrcited from accessing a record
;
;
;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
;
;IHS/OIT/LJF 08/31/2007 PATCH 1008
; check if users is restricted from accessing this patient's record
I $$STATUS^BDGSPT2(DUZ,DGY,1)["RESTRICTED ACCESS" D Q
. S Y=-1
. NEW MSG S MSG(2)="Sorry, you are restricted from accessing this patient's record."
. S MSG(3)="If you have questions, please contact your HIM department."
. D DISP(.MSG)
; end of PATCH 1008 code
;
;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 G Q ;IHS/ANMC/LJF 8/31/2001
;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))
;
;IHS/ANMC/LJF 8/31/2001 if site parameter says log all patients
; if set to 2, means non-sensitive so log anyway
;IHS/ITSC/WAR 3/17/2005 Fix dealing with calls from other apps/pkgs
; REM'd next 3 lines
;I DGSENS(1)[0 D G Q
;. I DGSENS(1)=0 Q:$$GET1^DIQ(43,1,9999999.01)'="YES" ;track all not on
;. S DGSENS(1)=0 ;reset if = 0^0
I DGSENS(1)=0 D G Q
. I $$GET1^DIQ(43,1,9999999.01)'="YES"&('$P($G(^DGSL(38.1,+DGY,0)),U,2)) Q ;track all not on. End of 3/17/2005 modification cmi/maw 1/26/2010 PATCH 1011
. D SETLOG1(+Y,DUZ,,DGOPT) ;set log entry
;IHS/ANMC/LJF 8/31/2001 end of new code
;
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 DISP(.DGSENS)
..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
.I FLAG=0 S ^DGSL(38.1,"ANS",+DFN)="" ;IHS/ITSC/LJF 10/02/2003
.;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)
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 XMB(1)=XMB(1)_" (#"_$$HRCN^BDGF2(+DFN,DUZ(2))_")" ;IHS/ANMC/LJF 9/7/2000
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
.S DGWHERE=(80-$L(ARRAY(DGI)))\2
.W ?DGWHERE,ARRAY(DGI),!
Q
;
NOTCE1 W:'$D(DDS) !! W "Do you want to continue processing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D W:'$D(DDS) !! W "Enter 'YES' to continue processing, or 'NO' to quit processing 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
DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
+1 ;;5.3;PIMS;**32,46,197,214,249,281,352,391,425,582,1002,1008,1009,1011,1015,1016**;JUN 30, 2012;Build 20
+2 ;IHS/ANMC/LJF 9/7/2000 added chart # to bulletin
+3 ; 8/31/2001 added code to track all patients per parameter
+4 ; 10/02/2003 VA added code to add patient but not setting of ANS xref
+5 ;IHS/ITSC/WAR 3/17/2005 Fix dealing with calls from other apps/pkgs
+6 ;IHS/OIT/LJF 08/31/2007 PATCH 1008 added code to check if user is restrcited from accessing a record
+7 ;
+8 ;
+9 ;Entry point from DPTLK
+10 IF +$GET(Y)=+$GET(^DISV(DUZ,"^DPT("))
IF $GET(DPTBTDT)
KILL DPTBTDT
QUIT
+11 NEW DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1
+12 ;Y=Patient file DFN
+13 SET DGY=Y
+14 ;
+15 ;IHS/OIT/LJF 08/31/2007 PATCH 1008
+16 ; check if users is restricted from accessing this patient's record
+17 IF $$STATUS^BDGSPT2(DUZ,DGY,1)["RESTRICTED ACCESS"
Begin DoDot:1
+18 SET Y=-1
+19 NEW MSG
SET MSG(2)="Sorry, you are restricted from accessing this patient's record."
+20 SET MSG(3)="If you have questions, please contact your HIM department."
+21 DO DISP(.MSG)
End DoDot:1
QUIT
+22 ; end of PATCH 1008 code
+23 ;
+24 ;OWNREC^DGSEC4 parameters:
+25 ; DGREC = output array passed by reference
+26 ; DGY = Patient file DFN
+27 ; DUZ = New Person file IEN
+28 ; 1=generate error msg
+29 ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry
+30 ; DGPTSSN - set to patient's SSN when adding new Patient file entry
+31 ; X=Patient's SSN from DPTLK2
+32 IF $GET(DGNEWPT)=1
SET DGPTSSN=X
+33 DO OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$GET(DGNEWPT),$GET(DGPTSSN))
+34 SET Y=DGY
+35 IF DGREC(1)=1!(DGREC(1)=2)
Begin DoDot:1
+36 SET Y=-1
+37 DO DISP(.DGREC)
+38 IF $DATA(DDS)
READ !,"Please enter any key to continue.",DGANS:DTIME
End DoDot:1
GOTO Q
+39 ;SENS^DGSEC4 parameters:
+40 ; DGSENS = output array passed by reference
+41 ; Y = Patient fileDFN
+42 ; DUZ = New Person file IEN
+43 ; DDS - Screenman variable
+44 ; DGSENFLG - If defined, patient record sensitivity not checked
+45 DO SENS^DGSEC4(.DGSENS,+Y,DUZ,$GET(DDS),.DGSENFLG)
+46 ;DUZ must be defined to access a sensitive record
+47 IF DGSENS(1)=-1
Begin DoDot:1
+48 SET Y=-1
+49 DO DISP(.DGSENS)
End DoDot:1
GOTO Q
+50 ;I DGSENS(1)=0 G Q ;IHS/ANMC/LJF 8/31/2001
+51 ;Get option name for DG Security Log file and bulletin
+52 DO OP^XQCHK
SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
+53 ;
+54 ;IHS/ANMC/LJF 8/31/2001 if site parameter says log all patients
+55 ; if set to 2, means non-sensitive so log anyway
+56 ;IHS/ITSC/WAR 3/17/2005 Fix dealing with calls from other apps/pkgs
+57 ; REM'd next 3 lines
+58 ;I DGSENS(1)[0 D G Q
+59 ;. I DGSENS(1)=0 Q:$$GET1^DIQ(43,1,9999999.01)'="YES" ;track all not on
+60 ;. S DGSENS(1)=0 ;reset if = 0^0
+61 IF DGSENS(1)=0
Begin DoDot:1
+62 ;track all not on. End of 3/17/2005 modification cmi/maw 1/26/2010 PATCH 1011
IF $$GET1^DIQ(43,1,9999999.01)'="YES"&('$PIECE($GET(^DGSL(38.1,+DGY,0)),U,2))
QUIT
+63 ;set log entry
DO SETLOG1(+Y,DUZ,,DGOPT)
End DoDot:1
GOTO Q
+64 ;IHS/ANMC/LJF 8/31/2001 end of new code
+65 ;
+66 IF DGSENS(1)=1
Begin DoDot:1
+67 IF DIC(0)["E"
Begin DoDot:2
+68 WRITE $CHAR(7)
+69 DO DISP(.DGSENS)
End DoDot:2
+70 IF Y>0
Begin DoDot:2
+71 ;Parameters: DFN,DUZ,,Option name^Menu text
+72 DO SETLOG1(+Y,DUZ,,DGOPT)
End DoDot:2
End DoDot:1
+73 IF DGSENS(1)=2
Begin DoDot:1
+74 IF DIC(0)["E"
Begin DoDot:2
+75 WRITE $CHAR(7)
+76 DO DISP(.DGSENS)
+77 DO NOTCE1
End DoDot:2
+78 IF Y>0
Begin DoDot:2
+79 DO SETLOG1(+Y,DUZ,,DGOPT)
+80 ;Parameters: DFN,DUZ,Option name^Menu text,message array
+81 DO BULTIN1(+Y,DUZ,DGOPT,.DGMSG)
+82 IF $DATA(DGSM)
IF DIC(0)["E"
DO DISP(.DGMSG)
End DoDot:2
End DoDot:1
+83 DO Q
+84 QUIT
+85 ;
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 ;IHS/ITSC/LJF 10/02/2003
IF FLAG=0
SET ^DGSL(38.1,"ANS",+DFN)=""
+17 ;Date/time sensitivity was set
+18 SET $PIECE(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT()
End DoDot:1
+19 ;determine if an inpatient
+20 DO H^DGUTL
+21 SET DGT=DGTIME
+22 IF $GET(DG1)=""
DO ^DGPMSTAT
+23 ;get option name
+24 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 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 ;IHS/ANMC/LJF 9/7/2000
SET XMB(1)=XMB(1)_" (#"_$$HRCN^BDGF2(+DFN,DUZ(2))_")"
+19 SET DGEMPLEE=$$EMPL^DGSEC4(+DFN)
+20 IF DGEMPLEE=1
SET XMB(1)=XMB(1)_" (Employee)"
+21 SET XMB(2)=$PIECE(^DPT(+DFN,0),U,9)
SET XMB(3)=$PIECE(DGOPT,U,2)
SET XMY("G."_DGB)=""
+22 NEW Y
SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET XMB(4)=Y
+23 DO SEND(.XMB,.XMY)
+24 SET DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer."
+25 QUIT
+26 ;
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 SET DGWHERE=(80-$LENGTH(ARRAY(DGI)))\2
+10 WRITE ?DGWHERE,ARRAY(DGI),!
End DoDot:1
+11 QUIT
+12 ;
NOTCE1 IF '$DATA(DDS)
WRITE !!
WRITE "Do you want to continue processing 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 processing, or 'NO' to quit processing 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
