source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQPT2.m@ 1373

Last change on this file since 1373 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1DGQPT2 ; HIRMFO/DAD-Patient Look-Up Security Check and Notification ;1/31/97 07:57
2 ;;5.3;Registration;**447**;Aug 13, 1993
3 ;
4EN1(DGDFN) ;
5 ; Sensitive Patient record check
6 ; Input
7 ; DGDFN = Pointer to the Patient file (#2)
8 ; Output
9 ; 0 - Patient record IS NOT sensitive
10 ; 1 - Patient record IS sensitive
11 ;
12 Q ''$$GET1^DIQ(38.1,+$G(DGDFN),2,"I")
13 ;
14EN2(DGDFN) ;
15 ; Update DG Security Log file (#38.1) and sends
16 ; the 'Restricted Patient Accessed' bulletin to the
17 ; mailgroup specified in the 'Sensitive Rec Accessed
18 ; Group' field (43,509)
19 ; Input
20 ; DGDFN = Pointer to the Patient file (#2)
21 ; Output
22 ; None
23 ;
24 I $S($G(DGDFN)'>0:1,$G(DUZ)'>0:1,1:'$$EN1(DGDFN)) Q
25 ;
26 N DFN,DG1,DGA1,DGT,DGXFR0,DGINPT,DGINVNOW,DGMAILGR,DGNOW,DGOPT
27 N X,XQOPT
28 ;
29 D OP^XQCHK
30 S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
31 S DGNOW=$E($$NOW^XLFDT,1,12)
32 S DFN=DGDFN,DGT=DGNOW D EN^DGPMSTAT S DGINPT=$S(DG1:"y",1:"n")
33 S DGMAILGR=$$GET1^DIQ(43,1,509)
34 ;
35 I DGINPT="n",'$D(^XUSEC("DG SENSITIVITY",DUZ)),DGMAILGR]"" D
36 . N DGTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
37 . S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
38 . S XMY("G."_DGMAILGR)=""
39 . S XMTEXT="DGTEXT("
40 . S XMDUZ=DUZ
41 . S XMCHAN=1
42 . S DGTEXT(1)="The following sensitive patient record has been accessed:"
43 . S DGTEXT(2)=""
44 . S DGTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,DGDFN,.01)
45 . S DGTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,DGDFN,.09)
46 . S DGTEXT(5)=" Option Used : "_$P(DGOPT,U,2)
47 . D ^XMD
48 . Q
49 ;
50 F L +^DGSL(38.1,DGDFN):1 Q:$T
51 ;
52 I '$D(^DGSL(38.1,DGDFN)) D
53 . N DGFDA,DGIEN,DGMSG
54 . S DGFDA(38.1,"+1,",.01)=DGDFN
55 . S DGIEN(1)=DGDFN
56 . D UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
57 . Q
58 F S DGINVNOW=9999999.9999-DGNOW Q:'$D(^DGSL(38.1,DGDFN,"D",DGINVNOW)) S DGNOW=DGNOW+.00001
59 N DGFDA,DGIEN,DGMSG
60 S DGFDA(38.11,"+1,"_DGDFN_",",.01)=DGNOW
61 S DGFDA(38.11,"+1,"_DGDFN_",",2)=DUZ
62 S DGFDA(38.11,"+1,"_DGDFN_",",3)=$P(DGOPT,U,2)
63 S DGFDA(38.11,"+1,"_DGDFN_",",4)=DGINPT
64 S DGIEN(1)=DGINVNOW
65 D UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
66 ;
67 L -^DGSL(38.1,DGDFN)
68 ;
69 S X="MPRCHK" X ^%ZOSF("TEST") I $T D EN^MPRCHK(DGDFN)
70 ;
71 Q
72 ;
73CWAD(DFN) ;
74 ; Crisis notes, clinical Warnings, Allergies, advance Directives
75 ; Input:
76 ; DFN = A Patient file (#2) IEN
77 ; Output:
78 ; A string of 0-4 nonrepeating characters consisting
79 ; of the letters C,W,A,D. The string will be returned
80 ; with the letters in the order shown.
81 ;
82 I $G(DFN)'>0 Q ""
83 N ACRN,CTR,ORLST,MSG
84 D ENCOVER^TIUPP3(DFN)
85 ; DGLST initialized with lower case 'cwad' to generate
86 ; correct ordering of letters. Lower case letter indicates
87 ; that the patient does not have that item. Upper case
88 ; indicates that the patient has the item.
89 S DGLST="cwad"
90 S CTR=0
91 F S CTR=$O(^TMP("TIUPPCV",$J,CTR)) Q:(CTR'>0)!(DGLST?4U) D
92 . S ACRN=$P($G(^TMP("TIUPPCV",$J,CTR)),U,2)
93 . ; If patient has item, convert item to uppercase
94 . I "^C^W^A^D^"[(U_ACRN_U) S DGLST=$TR(DGLST,$C($A(ACRN)+32),ACRN)
95 . Q
96 K ^TMP("TIUPPCV",$J)
97 ; Remove any remaining lower case items
98 S DGLST=$TR(DGLST,"cwad")
99 Q DGLST
Note: See TracBrowser for help on using the repository browser.