DGQPT2 ; HIRMFO/DAD-Patient Look-Up Security Check and Notification ;1/31/97 07:57
;;5.3;Registration;**447**;Aug 13, 1993
;
EN1(DGDFN) ;
; Sensitive Patient record check
; Input
; DGDFN = Pointer to the Patient file (#2)
; Output
; 0 - Patient record IS NOT sensitive
; 1 - Patient record IS sensitive
;
Q ''$$GET1^DIQ(38.1,+$G(DGDFN),2,"I")
;
EN2(DGDFN) ;
; Update DG Security Log file (#38.1) and sends
; the 'Restricted Patient Accessed' bulletin to the
; mailgroup specified in the 'Sensitive Rec Accessed
; Group' field (43,509)
; Input
; DGDFN = Pointer to the Patient file (#2)
; Output
; None
;
I $S($G(DGDFN)'>0:1,$G(DUZ)'>0:1,1:'$$EN1(DGDFN)) Q
;
N DFN,DG1,DGA1,DGT,DGXFR0,DGINPT,DGINVNOW,DGMAILGR,DGNOW,DGOPT
N X,XQOPT
;
D OP^XQCHK
S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
S DGNOW=$E($$NOW^XLFDT,1,12)
S DFN=DGDFN,DGT=DGNOW D EN^DGPMSTAT S DGINPT=$S(DG1:"y",1:"n")
S DGMAILGR=$$GET1^DIQ(43,1,509)
;
I DGINPT="n",'$D(^XUSEC("DG SENSITIVITY",DUZ)),DGMAILGR]"" D
. N DGTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
. S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
. S XMY("G."_DGMAILGR)=""
. S XMTEXT="DGTEXT("
. S XMDUZ=DUZ
. S XMCHAN=1
. S DGTEXT(1)="The following sensitive patient record has been accessed:"
. S DGTEXT(2)=""
. S DGTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,DGDFN,.01)
. S DGTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,DGDFN,.09)
. S DGTEXT(5)=" Option Used : "_$P(DGOPT,U,2)
. D ^XMD
. Q
;
F L +^DGSL(38.1,DGDFN):1 Q:$T
;
I '$D(^DGSL(38.1,DGDFN)) D
. N DGFDA,DGIEN,DGMSG
. S DGFDA(38.1,"+1,",.01)=DGDFN
. S DGIEN(1)=DGDFN
. D UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
. Q
F S DGINVNOW=9999999.9999-DGNOW Q:'$D(^DGSL(38.1,DGDFN,"D",DGINVNOW)) S DGNOW=DGNOW+.00001
N DGFDA,DGIEN,DGMSG
S DGFDA(38.11,"+1,"_DGDFN_",",.01)=DGNOW
S DGFDA(38.11,"+1,"_DGDFN_",",2)=DUZ
S DGFDA(38.11,"+1,"_DGDFN_",",3)=$P(DGOPT,U,2)
S DGFDA(38.11,"+1,"_DGDFN_",",4)=DGINPT
S DGIEN(1)=DGINVNOW
D UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
;
L -^DGSL(38.1,DGDFN)
;
S X="MPRCHK" X ^%ZOSF("TEST") I $T D EN^MPRCHK(DGDFN)
;
Q
;
CWAD(DFN) ;
; Crisis notes, clinical Warnings, Allergies, advance Directives
; Input:
; DFN = A Patient file (#2) IEN
; Output:
; A string of 0-4 nonrepeating characters consisting
; of the letters C,W,A,D. The string will be returned
; with the letters in the order shown.
;
I $G(DFN)'>0 Q ""
N ACRN,CTR,ORLST,MSG
D ENCOVER^TIUPP3(DFN)
; DGLST initialized with lower case 'cwad' to generate
; correct ordering of letters. Lower case letter indicates
; that the patient does not have that item. Upper case
; indicates that the patient has the item.
S DGLST="cwad"
S CTR=0
F S CTR=$O(^TMP("TIUPPCV",$J,CTR)) Q:(CTR'>0)!(DGLST?4U) D
. S ACRN=$P($G(^TMP("TIUPPCV",$J,CTR)),U,2)
. ; If patient has item, convert item to uppercase
. I "^C^W^A^D^"[(U_ACRN_U) S DGLST=$TR(DGLST,$C($A(ACRN)+32),ACRN)
. Q
K ^TMP("TIUPPCV",$J)
; Remove any remaining lower case items
S DGLST=$TR(DGLST,"cwad")
Q DGLST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGQPT2 3146 printed Dec 13, 2024@02:54:39 Page 2
DGQPT2 ; HIRMFO/DAD-Patient Look-Up Security Check and Notification ;1/31/97 07:57
+1 ;;5.3;Registration;**447**;Aug 13, 1993
+2 ;
EN1(DGDFN) ;
+1 ; Sensitive Patient record check
+2 ; Input
+3 ; DGDFN = Pointer to the Patient file (#2)
+4 ; Output
+5 ; 0 - Patient record IS NOT sensitive
+6 ; 1 - Patient record IS sensitive
+7 ;
+8 QUIT ''$$GET1^DIQ(38.1,+$GET(DGDFN),2,"I")
+9 ;
EN2(DGDFN) ;
+1 ; Update DG Security Log file (#38.1) and sends
+2 ; the 'Restricted Patient Accessed' bulletin to the
+3 ; mailgroup specified in the 'Sensitive Rec Accessed
+4 ; Group' field (43,509)
+5 ; Input
+6 ; DGDFN = Pointer to the Patient file (#2)
+7 ; Output
+8 ; None
+9 ;
+10 IF $SELECT($GET(DGDFN)'>0:1,$GET(DUZ)'>0:1,1:'$$EN1(DGDFN))
QUIT
+11 ;
+12 NEW DFN,DG1,DGA1,DGT,DGXFR0,DGINPT,DGINVNOW,DGMAILGR,DGNOW,DGOPT
+13 NEW X,XQOPT
+14 ;
+15 DO OP^XQCHK
+16 SET DGOPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
+17 SET DGNOW=$EXTRACT($$NOW^XLFDT,1,12)
+18 SET DFN=DGDFN
SET DGT=DGNOW
DO EN^DGPMSTAT
SET DGINPT=$SELECT(DG1:"y",1:"n")
+19 SET DGMAILGR=$$GET1^DIQ(43,1,509)
+20 ;
+21 IF DGINPT="n"
IF '$DATA(^XUSEC("DG SENSITIVITY",DUZ))
IF DGMAILGR]""
Begin DoDot:1
+22 NEW DGTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+23 SET XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
+24 SET XMY("G."_DGMAILGR)=""
+25 SET XMTEXT="DGTEXT("
+26 SET XMDUZ=DUZ
+27 SET XMCHAN=1
+28 SET DGTEXT(1)="The following sensitive patient record has been accessed:"
+29 SET DGTEXT(2)=""
+30 SET DGTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,DGDFN,.01)
+31 SET DGTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,DGDFN,.09)
+32 SET DGTEXT(5)=" Option Used : "_$PIECE(DGOPT,U,2)
+33 DO ^XMD
+34 QUIT
End DoDot:1
+35 ;
+36 FOR
LOCK +^DGSL(38.1,DGDFN):1
if $TEST
QUIT
+37 ;
+38 IF '$DATA(^DGSL(38.1,DGDFN))
Begin DoDot:1
+39 NEW DGFDA,DGIEN,DGMSG
+40 SET DGFDA(38.1,"+1,",.01)=DGDFN
+41 SET DGIEN(1)=DGDFN
+42 DO UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
+43 QUIT
End DoDot:1
+44 FOR
SET DGINVNOW=9999999.9999-DGNOW
if '$DATA(^DGSL(38.1,DGDFN,"D",DGINVNOW))
QUIT
SET DGNOW=DGNOW+.00001
+45 NEW DGFDA,DGIEN,DGMSG
+46 SET DGFDA(38.11,"+1,"_DGDFN_",",.01)=DGNOW
+47 SET DGFDA(38.11,"+1,"_DGDFN_",",2)=DUZ
+48 SET DGFDA(38.11,"+1,"_DGDFN_",",3)=$PIECE(DGOPT,U,2)
+49 SET DGFDA(38.11,"+1,"_DGDFN_",",4)=DGINPT
+50 SET DGIEN(1)=DGINVNOW
+51 DO UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
+52 ;
+53 LOCK -^DGSL(38.1,DGDFN)
+54 ;
+55 SET X="MPRCHK"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^MPRCHK(DGDFN)
+56 ;
+57 QUIT
+58 ;
CWAD(DFN) ;
+1 ; Crisis notes, clinical Warnings, Allergies, advance Directives
+2 ; Input:
+3 ; DFN = A Patient file (#2) IEN
+4 ; Output:
+5 ; A string of 0-4 nonrepeating characters consisting
+6 ; of the letters C,W,A,D. The string will be returned
+7 ; with the letters in the order shown.
+8 ;
+9 IF $GET(DFN)'>0
QUIT ""
+10 NEW ACRN,CTR,ORLST,MSG
+11 DO ENCOVER^TIUPP3(DFN)
+12 ; DGLST initialized with lower case 'cwad' to generate
+13 ; correct ordering of letters. Lower case letter indicates
+14 ; that the patient does not have that item. Upper case
+15 ; indicates that the patient has the item.
+16 SET DGLST="cwad"
+17 SET CTR=0
+18 FOR
SET CTR=$ORDER(^TMP("TIUPPCV",$JOB,CTR))
if (CTR'>0)!(DGLST?4U)
QUIT
Begin DoDot:1
+19 SET ACRN=$PIECE($GET(^TMP("TIUPPCV",$JOB,CTR)),U,2)
+20 ; If patient has item, convert item to uppercase
+21 IF "^C^W^A^D^"[(U_ACRN_U)
SET DGLST=$TRANSLATE(DGLST,$CHAR($ASCII(ACRN)+32),ACRN)
+22 QUIT
End DoDot:1
+23 KILL ^TMP("TIUPPCV",$JOB)
+24 ; Remove any remaining lower case items
+25 SET DGLST=$TRANSLATE(DGLST,"cwad")
+26 QUIT DGLST
