source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGSEC4.m@ 1645

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1DGSEC4 ;ALB/MM,JAP - Utilities for record access & sensitive record processing;10/6/99 ; 10/26/05 12:46pm
2 ;;5.3;Registration;**249,281,391,471,684,699**;Aug 13, 1993
3 ;
4 ;Line tags OWNREC & SENS moved from DGSEC in DG*5.3*249 when DGSEC
5 ;reached the maximum routine size.
6 ;
7PTSEC(RESULT,DFN,DGMSG,DGOPT) ;RPC/API entry point for patient sensitive & record access checks
8 ;Output array (Required)
9 ; RESULT(1)= -1-RPC/API failed
10 ; Required variable not defined
11 ; 0-No display/action required
12 ; Not accessing own, employee, or sensitive record
13 ; 1-Display warning message
14 ; Sensitive and DG SENSITIVITY key holder
15 ; or Employee and DG SECURITY OFFICER key holder
16 ; 2-Display warning message/require OK to continue
17 ; Sensitive and not a DG SENSITIVITY key holder
18 ; Employee and not a DG SECURITY OFFICER key holder
19 ; 3-Access to record denied
20 ; Accessing own record
21 ; 4-Access to Patient (#2) file records denied
22 ; SSN not defined
23 ; RESULT(2-10) = error or display messages
24 ;
25 ;Input parameters: DFN = Patient file entry (Required)
26 ; DGMSG = If 1, generate message (optional)
27 ; DGOPT = Option name^Menu text (Optional)
28 ;
29 K RESULT
30 I $G(DFN)="" D Q
31 .S RESULT(1)=-1
32 .S RESULT(2)="Required variable missing."
33 S DGMSG=$G(DGMSG)
34 D OWNREC(.RESULT,DFN,$G(DUZ),DGMSG)
35 I RESULT(1)=1 S RESULT(1)=3 Q
36 I RESULT(1)=2 S RESULT(1)=4 Q
37 K RESULT
38 D SENS(.RESULT,DFN,$G(DUZ))
39 I RESULT(1)=1 D
40 .I $G(DUZ)="" D Q
41 ..;DUZ must be defined to access sensitive record & update DG Security log
42 ..S RESULT(1)=-1
43 ..S RESULT(2)="Your user code is undefined. This must be defined to access a restricted patient record."
44 .D SETLOG1^DGSEC(DFN,DUZ,,$G(DGOPT))
45 Q
46NOTICE(RESULT,DFN,DGOPT,ACTION) ;RPC/API entry point for log entry and message generation
47 ;Input parameters:
48 ; DFN = Patient file DFN
49 ; DGOPT = Option name^Menu text (Optional)
50 ; ACTION = 1 - Set DG Security Log entry, 2 - Generate mail
51 ; message, 3 - Both (Optional - Defaults to both)
52 ;
53 ;Output: RESULT = 1 - DG Security Log updated and/or Sensitive Record msg sent (Determined by ACTION value)
54 ; 0 - Required variable undefined
55 ;
56 I $G(DFN)="" S RESULT=0 Q
57 I $G(DUZ)="" S RESULT=0 Q
58 S DGOPT=$G(DGOPT)
59 I $G(ACTION)="" S ACTION=3
60 I ACTION'=1 D BULTIN1^DGSEC(DFN,DUZ,DGOPT)
61 I ACTION'=2 D SETLOG1^DGSEC(DFN,DUZ,,DGOPT)
62 S RESULT=1
63 Q
64 ;
65OWNREC(DGREC,DFN,DGDUZ,DGMSG,DGNEWPT,DGPTSSN) ;Determine if user accessing his/her own Patient file (#2) record
66 ;Input:
67 ; DGREC - Array name passed by reference
68 ; DFN - Patient (#2) file IEN
69 ; DGDUZ - New Person (#200) file IEN (Not required. If not sent will return 0.)
70 ; DGMSG - If 1, generate message (Optional) Will default to 1
71 ; DGNEWPT - Set to 1 when adding a new entry to the Patient file
72 ; DGPTSSN - new patient's SSN
73 ; DGNEWPT & DGPTSSN parameters only defined if DPTLK is adding
74 ; a new Patient (#2) file entry
75 ;
76 ;Output:
77 ; DGREC(1)=0 - Not attempting to access own Patient (#2) file record,
78 ; DUZ not defined, RESTRICT PATIENT RECORD ACCESS parameter
79 ; in MAS Parameters (#43) file not set to yes, or user holds
80 ; DG RECORD ACCESS security key.
81 ; =1 - Attempting to access own Patient file record
82 ; =2 - SSN undefined
83 ; =-1 - Required variable not defined.
84 ; Other nodes in array will contain error message text.
85 ;
86 ;DFN required
87 I '$D(DFN),($G(DGNEWPT)'=1) D Q
88 .S DGREC(1)=-1
89 .S DGREC(2)="DFN not defined."
90 S DGREC(1)=0
91 ;Check if parameter is on
92 I +$P($G(^DG(43,1,"REC")),U)=0 Q
93 N DGNPSSN
94 ;I $D(DUZ)=0 Q
95 I (+$G(DGDUZ))<1 Q
96 ;Check if user holds security key
97 I $D(^XUSEC("DG RECORD ACCESS",DGDUZ)) Q
98 I $G(DGMSG)="" S DGMSG=1
99 N DGNPERR
100 ; quit if user is a proxy user, i.e., not a real person
101 I $$ACTIVE^XUSAP(DGDUZ),$$USERTYPE^XUSAP(DGDUZ,"CONNECTOR PROXY")!($$USERTYPE^XUSAP(DGDUZ,"APPLICATION PROXY")) Q
102 S DGNPSSN=$$GET1^DIQ(200,DGDUZ_",",9,"I","","DGNPERR")
103 I 'DGNPSSN D Q
104 .S DGREC(1)=2
105 .S DGREC(2)="Your SSN is missing from the NEW PERSON file. Contact your ADP Coordinator."
106 .;Only send message if parameter set to 1
107 .I DGMSG=1 D MSG(DGDUZ)
108 I +$G(DGNEWPT)'=1 S DGPTSSN=$P($G(^DPT(DFN,0)),U,9)
109 I +$G(DGNEWPT)=1 S DGPTSSN=$TR(DGPTSSN,"-","")
110 I DGNPSSN=DGPTSSN D Q
111 .S DGREC(1)=1
112 .S DGREC(2)="Security regulations prohibit computer access to your own medical record."
113 Q
114MSG(DGDUZ) ;Send Missing SSN in New Person file message to mailgroup
115 ;Input: DGDUZ - New Person (#200) file IEN (Required)
116 ;
117 N DGNPERR,DGNPNAME,DGTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
118 S DGNPNAME=$$GET1^DIQ(200,DGDUZ_",",.01,"","DGNPERR")
119 S XMSUB="MISSING SSN IN NEW PERSON FILE"
120 S DGTEXT(1)="The following NEW PERSON record does not contain a Social Security Number."
121 S DGTEXT(2)="This is required to access PATIENT file entries."
122 S DGTEXT(3)=""
123 S DGTEXT(4)=$S(DGNPNAME'="":DGNPNAME,1:"UNKNOWN")
124 S DGTEXT(5)="NEW PERSON (#200) File Internal Entry Number (DUZ): "_+DGDUZ
125 S DGTEXT(6)=""
126 S DGTEXT(7)="This message has been sent to DG MISSING NEW PERSON SSN mail group."
127 S DGTEXT(8)="Please take appropriate action."
128 S XMTEXT="DGTEXT("
129 S XMDUZ=$S(DGNPNAME'="":DGNPNAME,1:.5)
130 S XMY("G.DG MISSING NEW PERSON SSN")=""
131 S XMCHAN=1
132 D ^XMD
133 Q
134SENS(DGSENS,DFN,DGDUZ,DDS,DGSENFLG) ;Determine if sensitive record
135 ;Input:
136 ; DGSENS - Array name passed by reference
137 ; DFN - Patient (#2) file IEN (Required)
138 ; DGDUZ - New Person (#200) file IEN
139 ; DDS - Screenman variable
140 ; DGSENFLG - If defined, patient record sensitivity not checked
141 ;
142 ;Output:
143 ; DGSENS(1)=0 - Record is not sensitive or DGSENFLG set
144 ; =1 - Sensitive record and user holds DG SENSITIVITY key
145 ; - Employee and user holds DG SECURITY OFFICER key
146 ; =2 - Sensitive record and user does not hold key
147 ; - Employee and user does not hold key
148 ; =-1 - Required input variable not defined
149 ; If 1, 2 or -1, array will contain error/display message
150 ;
151 N DGMSG,DGA1,DG1,DGDATE,DGLNE,DGT,DGTIME,DGEMPLEE
152 ;Patient file DFN must be defined.
153 I '$D(DFN) D Q
154 .S DGSENS(1)=-1
155 .S DGSENS(2)="DFN not defined."
156 S DGSENS(1)=0
157 I $D(DGSENFLG) Q
158 ;Determine if patient is employee
159 S DGEMPLEE=$$EMPL(DFN)
160 ;Quit if not an employee & not found in DG Security Log file
161 I 'DGEMPLEE,('$D(^DGSL(38.1,+DFN,0))) Q
162 ;Quit if not an employee and not flagged as sensitive
163 I 'DGEMPLEE,($P($G(^DGSL(38.1,+DFN,0)),U,2)'=1) Q
164 ;DUZ & user name must be defined
165 S DGMSG=$S('$G(DGDUZ):"user code",'$D(^VA(200,DGDUZ,0)):"user name",1:"")
166 I DGMSG'="" D Q
167 .S DGSENS(1)=-1
168 .S DGSENS(2)="Your "_DGMSG_" is undefined. This must be defined to access"
169 .S DGSENS(3)=" a restricted patient record."
170 S DGSENS(1)=1
171 ;Inpatient check - no longer used (kept for future reference)
172 ;D H^DGUTL S DGT=DGTIME D ^DGPMSTAT
173 S DGSENS(2)="***WARNING***"
174 I $G(DDS)'="" S DGSENS(2)=DGSENS(2)_" ***RESTRICTED RECORD***"
175 I $G(DDS)="" S DGSENS(3)="***RESTRICTED RECORD***"
176 I DGEMPLEE,('$D(^XUSEC("DG SECURITY OFFICER",+$G(DGDUZ)))) D Q
177 .S DGSENS(1)=2
178 .D PRIV
179 I '$D(^XUSEC("DG SENSITIVITY",+$G(DGDUZ))) D
180 .S DGSENS(1)=2
181 .D PRIV
182 Q
183PRIV ;Privacy Act statement for DGSENS array
184 S $P(DGLNE,"* ",38)=""
185 I $G(DDS)="" S DGSENS(4)=DGLNE
186 S DGSENS(5)="* This record is protected by the Privacy Act of 1974 and the Health *"
187 S DGSENS(6)="* Insurance Portability and Accountability Act of 1996. If you elect *"
188 S DGSENS(7)="* to proceed, you will be required to prove you have a need to know. *"
189 S DGSENS(8)="* Accessing this patient is tracked, and your station Security Officer *"
190 S DGSENS(9)="* will contact you for your justification. *"
191 I $G(DDS)="" S DGSENS(10)=DGLNE
192 Q
193EMPL(DFN,DGCHELIG) ;Does patient have any eligibility codes equal to
194 ; EMPLOYEE
195 ;Input:
196 ; DFN - Patient (#2) file IEN (required).
197 ; DGCHELIG - Flags to determine mode of execution (optional).
198 ; Value of the parameter can contain any combination
199 ; of the following characters:
200 ; "P" - check primary eligibility code
201 ; "S" - check secondary eligibility codes
202 ;
203 ; If this parameter is either not defined or set to an
204 ; illegal value, the value of "PS" will be assumed.
205 ;Output:
206 ; 1 - Patient has EMPLOYEE as an eligibility code
207 ; 0 - Patient doesn't have EMPLOYEE as an eligibility code
208 ;
209 ;Notes: EMPLOYEE is entry 14 in the MAS ELIGIBILITY CODE file (#8.1)
210 N DGELIG,DGEMPLEE
211 S DGEMPLEE=0
212 I $G(DGCHELIG)'["P",$G(DGCHELIG)'["S" S DGCHELIG="PS"
213 ;Check primary eligibility
214 I DGCHELIG["P" D
215 .S DGELIG=+$G(^DPT(DFN,.36))
216 .I $D(^DIC(8,"D",14,DGELIG)) S DGEMPLEE=1
217 ;Check secondary eligibilities (if needed)
218 I DGCHELIG["S",'DGEMPLEE D
219 .S DGELIG=0
220 .F S DGELIG=+$O(^DPT("AEL",DFN,DGELIG)) Q:'DGELIG I $D(^DIC(8,"D",14,DGELIG)) S DGEMPLEE=1 Q
221 Q DGEMPLEE
Note: See TracBrowser for help on using the repository browser.