ORQPT2 ; HIRMFO/DAD-Patient Look-Up Security Check and Notification ;1/31/97 07:57
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
;
EN1(ORDFN) ;
; Sensitive Patient record check
; Input
; ORDFN = Pointer to the Patient file (#2)
; Output
; 0 - Patient record IS NOT sensitive
; 1 - Patient record IS sensitive
;
Q ''$$GET1^DIQ(38.1,+$G(ORDFN),2,"I")
;
EN2(ORDFN) ;
; 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
; ORDFN = Pointer to the Patient file (#2)
; Output
; None
;
I $S($G(ORDFN)'>0:1,$G(DUZ)'>0:1,1:'$$EN1(ORDFN)) Q
;
N DFN,DG1,DGA1,DGT,DGXFR0
N ORINPT,ORINVNOW,ORMAILGR,ORNOW,OROPT
N X,XQOPT
;
D OP^XQCHK
S OROPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
S ORNOW=$E($$NOW^XLFDT,1,12)
S DFN=ORDFN,DGT=ORNOW D EN^DGPMSTAT S ORINPT=$S(DG1:"y",1:"n")
S ORMAILGR=$$GET1^DIQ(43,1,509)
;
I ORINPT="n",'$D(^XUSEC("DG SENSITIVITY",DUZ)),ORMAILGR]"" D
. N ORTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
. S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
. S XMY("G."_ORMAILGR)=""
. S XMTEXT="ORTEXT("
. S XMDUZ=DUZ
. S XMCHAN=1
. S ORTEXT(1)="The following sensitive patient record has been accessed:"
. S ORTEXT(2)=""
. S ORTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,ORDFN,.01)
. S ORTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,ORDFN,.09)
. S ORTEXT(5)=" Option Used : "_$P(OROPT,U,2)
. D ^XMD
. Q
;
F L +^DGSL(38.1,ORDFN):1 Q:$T
;
I '$D(^DGSL(38.1,ORDFN)) D
. N ORFDA,ORIEN,ORMSG
. S ORFDA(38.1,"+1,",.01)=ORDFN
. S ORIEN(1)=ORDFN
. D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
. Q
F S ORINVNOW=9999999.9999-ORNOW Q:'$D(^DGSL(38.1,ORDFN,"D",ORINVNOW)) S ORNOW=ORNOW+.00001
N ORFDA,ORIEN,ORMSG
S ORFDA(38.11,"+1,"_ORDFN_",",.01)=ORNOW
S ORFDA(38.11,"+1,"_ORDFN_",",2)=DUZ
S ORFDA(38.11,"+1,"_ORDFN_",",3)=$P(OROPT,U,2)
S ORFDA(38.11,"+1,"_ORDFN_",",4)=ORINPT
S ORIEN(1)=ORINVNOW
D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
;
L -^DGSL(38.1,ORDFN)
;
S X="MPRCHK" X ^%ZOSF("TEST") I $T D EN^MPRCHK(ORDFN)
;
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)
; ORLST 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 ORLST="cwad"
S CTR=0
F S CTR=$O(^TMP("TIUPPCV",$J,CTR)) Q:(CTR'>0)!(ORLST?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 ORLST=$TR(ORLST,$C($A(ACRN)+32),ACRN)
. Q
K ^TMP("TIUPPCV",$J)
; Remove any remaining lower case items
S ORLST=$TR(ORLST,"cwad")
Q ORLST
ORQPT2 ; HIRMFO/DAD-Patient Look-Up Security Check and Notification ;1/31/97 07:57
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
+2 ;
EN1(ORDFN) ;
+1 ; Sensitive Patient record check
+2 ; Input
+3 ; ORDFN = 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(ORDFN),2,"I")
+9 ;
EN2(ORDFN) ;
+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 ; ORDFN = Pointer to the Patient file (#2)
+7 ; Output
+8 ; None
+9 ;
+10 IF $SELECT($GET(ORDFN)'>0:1,$GET(DUZ)'>0:1,1:'$$EN1(ORDFN))
QUIT
+11 ;
+12 NEW DFN,DG1,DGA1,DGT,DGXFR0
+13 NEW ORINPT,ORINVNOW,ORMAILGR,ORNOW,OROPT
+14 NEW X,XQOPT
+15 ;
+16 DO OP^XQCHK
+17 SET OROPT=$SELECT(+XQOPT<0:"^UNKNOWN",1:$PIECE(XQOPT,U)_U_$PIECE(XQOPT,U,2))
+18 SET ORNOW=$EXTRACT($$NOW^XLFDT,1,12)
+19 SET DFN=ORDFN
SET DGT=ORNOW
DO EN^DGPMSTAT
SET ORINPT=$SELECT(DG1:"y",1:"n")
+20 SET ORMAILGR=$$GET1^DIQ(43,1,509)
+21 ;
+22 IF ORINPT="n"
IF '$DATA(^XUSEC("DG SENSITIVITY",DUZ))
IF ORMAILGR]""
Begin DoDot:1
+23 NEW ORTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
+24 SET XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
+25 SET XMY("G."_ORMAILGR)=""
+26 SET XMTEXT="ORTEXT("
+27 SET XMDUZ=DUZ
+28 SET XMCHAN=1
+29 SET ORTEXT(1)="The following sensitive patient record has been accessed:"
+30 SET ORTEXT(2)=""
+31 SET ORTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,ORDFN,.01)
+32 SET ORTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,ORDFN,.09)
+33 SET ORTEXT(5)=" Option Used : "_$PIECE(OROPT,U,2)
+34 DO ^XMD
+35 QUIT
End DoDot:1
+36 ;
+37 FOR
LOCK +^DGSL(38.1,ORDFN):1
IF $TEST
QUIT
+38 ;
+39 IF '$DATA(^DGSL(38.1,ORDFN))
Begin DoDot:1
+40 NEW ORFDA,ORIEN,ORMSG
+41 SET ORFDA(38.1,"+1,",.01)=ORDFN
+42 SET ORIEN(1)=ORDFN
+43 DO UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
+44 QUIT
End DoDot:1
+45 FOR
SET ORINVNOW=9999999.9999-ORNOW
IF '$DATA(^DGSL(38.1,ORDFN,"D",ORINVNOW))
QUIT
SET ORNOW=ORNOW+.00001
+46 NEW ORFDA,ORIEN,ORMSG
+47 SET ORFDA(38.11,"+1,"_ORDFN_",",.01)=ORNOW
+48 SET ORFDA(38.11,"+1,"_ORDFN_",",2)=DUZ
+49 SET ORFDA(38.11,"+1,"_ORDFN_",",3)=$PIECE(OROPT,U,2)
+50 SET ORFDA(38.11,"+1,"_ORDFN_",",4)=ORINPT
+51 SET ORIEN(1)=ORINVNOW
+52 DO UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
+53 ;
+54 LOCK -^DGSL(38.1,ORDFN)
+55 ;
+56 SET X="MPRCHK"
XECUTE ^%ZOSF("TEST")
IF $TEST
DO EN^MPRCHK(ORDFN)
+57 ;
+58 QUIT
+59 ;
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 ; ORLST 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 ORLST="cwad"
+17 SET CTR=0
+18 FOR
SET CTR=$ORDER(^TMP("TIUPPCV",$JOB,CTR))
IF (CTR'>0)!(ORLST?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 ORLST=$TRANSLATE(ORLST,$CHAR($ASCII(ACRN)+32),ACRN)
+22 QUIT
End DoDot:1
+23 KILL ^TMP("TIUPPCV",$JOB)
+24 ; Remove any remaining lower case items
+25 SET ORLST=$TRANSLATE(ORLST,"cwad")
+26 QUIT ORLST
