Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGSEC4

DGSEC4.m

Go to the documentation of this file.
DGSEC4 ;ALB/MM,JAP,LAB,ATG/JPN,ISL/DKA - Utilities for record access & sensitive record processing ;July 6, 2020@21:55
 ;;5.3;Registration;**249,281,391,471,684,699,964,1130**;Aug 13, 1993;Build 7
 ;Per VHA Directive 6402, this routine should not be modified.
 ;
 ;Line tags OWNREC & SENS moved from DGSEC in DG*5.3*249 when DGSEC 
 ;reached the maximum routine size.
 ;
PTSEC(RESULT,DFN,DGMSG,DGOPT) ;RPC/API entry point for patient sensitive & record access checks
 ;Output array (Required)
 ;    RESULT(1)= -1-RPC/API failed
 ;                  Required variable not defined
 ;                0-No display/action required
 ;                  Not accessing own, employee, or sensitive record
 ;                1-Display warning message
 ;                  Sensitive and DG SENSITIVITY key holder
 ;                  or Employee and DG SECURITY OFFICER key holder
 ;                2-Display warning message/require OK to continue
 ;                  Sensitive and not a DG SENSITIVITY key holder
 ;                  Employee and not a DG SECURITY OFFICER key holder
 ;                3-Access to record denied
 ;                  Accessing own record
 ;                4-Access to Patient (#2) file records denied
 ;                  SSN not defined
 ;   RESULT(2-10) = error or display messages
 ;
 ;Input parameters: DFN = Patient file entry (Required)
 ;                  DGMSG = If 1, generate message (optional)
 ;                  DGOPT  = Option name^Menu text (Optional)
 ;
 K RESULT
 I $G(DFN)="" D  Q
 .S RESULT(1)=-1
 .S RESULT(2)="Required variable missing."
 S DGMSG=$G(DGMSG)
 D OWNREC(.RESULT,DFN,$G(DUZ),DGMSG)
 I RESULT(1)=1 S RESULT(1)=3 Q
 I RESULT(1)=2 S RESULT(1)=4 Q
 K RESULT
 D SENS(.RESULT,DFN,$G(DUZ))
 I RESULT(1)=1 D
 .I $G(DUZ)="" D  Q
 ..;DUZ must be defined to access sensitive record & update DG Security log
 ..S RESULT(1)=-1
 ..S RESULT(2)="Your user code is undefined.  This must be defined to access a restricted patient record."
 .D SETLOG1^DGSEC(DFN,DUZ,,$G(DGOPT))
 ;DG*5.3*964 hook to call VistA Audit Solution (VAS) for non-sensitive patient inquiries
 I (RESULT(1)=0) I $$GET1^DIQ(46.5,1,.02,"I") D SELAUD^DGAUDIT2(2,$G(DFN),"INQUIRY",$G(DGOPT))
 Q
NOTICE(RESULT,DFN,DGOPT,ACTION) ;RPC/API entry point for log entry and message generation
 ;Input parameters:  
 ;  DFN    = Patient file DFN
 ;  DGOPT  = Option name^Menu text (Optional)
 ;  ACTION = 1 - Set DG Security Log entry, 2 - Generate mail 
 ;           message, 3 - Both (Optional - Defaults to both)
 ;
 ;Output:  RESULT = 1 - DG Security Log updated and/or Sensitive Record msg sent (Determined by ACTION value)
 ;                  0 - Required variable undefined
 ;
 I $G(DFN)="" S RESULT=0 Q
 I $G(DUZ)="" S RESULT=0 Q
 S DGOPT=$G(DGOPT)
 I $G(ACTION)="" S ACTION=3
 I ACTION'=1 D BULTIN1^DGSEC(DFN,DUZ,DGOPT)
 I ACTION'=2 D SETLOG1^DGSEC(DFN,DUZ,,DGOPT)
 S RESULT=1
 Q
 ;
OWNREC(DGREC,DFN,DGDUZ,DGMSG,DGNEWPT,DGPTSSN) ;Determine if user accessing his/her own Patient file (#2) record
 ;Input:
 ; DGREC - Array name passed by reference
 ; DFN - Patient (#2) file IEN
 ; DGDUZ - New Person (#200) file IEN (Not required. If not sent will return 0.)
 ; DGMSG - If 1, generate message (Optional) Will default to 1
 ; DGNEWPT - Set to 1 when adding a new entry to the Patient file
 ; DGPTSSN - new patient's SSN
 ;   DGNEWPT & DGPTSSN parameters only defined if DPTLK is adding
 ;   a new Patient (#2) file entry  
 ;
 ;Output:
 ; DGREC(1)=0 - Not attempting to access own Patient (#2) file record, 
 ;            DUZ not defined, RESTRICT PATIENT RECORD ACCESS parameter
 ;            in MAS Parameters (#43) file not set to yes, or user holds
 ;            DG RECORD ACCESS security key.
 ;         =1 - Attempting to access own Patient file record
 ;         =2 - SSN undefined
 ;         =-1 - Required variable not defined.
 ; Other nodes in array will contain error message text.
 ;
 ;DFN required
 I '$D(DFN),($G(DGNEWPT)'=1) D  Q
 .S DGREC(1)=-1
 .S DGREC(2)="DFN not defined."
 S DGREC(1)=0
 ;Check if parameter is on
 I +$P($G(^DG(43,1,"REC")),U)=0 Q
 N DGNPSSN
 ;I $D(DUZ)=0 Q
 I (+$G(DGDUZ))<1 Q
 ;Check if user holds security key
 I $D(^XUSEC("DG RECORD ACCESS",DGDUZ)) Q
 I $G(DGMSG)="" S DGMSG=1
 N DGNPERR
 ; quit if user is a proxy user, i.e., not a real person
 I $$ACTIVE^XUSAP(DGDUZ),$$USERTYPE^XUSAP(DGDUZ,"CONNECTOR PROXY")!($$USERTYPE^XUSAP(DGDUZ,"APPLICATION PROXY")) Q
 S DGNPSSN=$$GET1^DIQ(200,DGDUZ_",",9,"I","","DGNPERR")
 I 'DGNPSSN D  Q
 .S DGREC(1)=2
 .S DGREC(2)="Your SSN is missing from the NEW PERSON file.  Contact your ADP Coordinator."
 .;Only send message if parameter set to 1
 .I DGMSG=1 D MSG(DGDUZ)
 I +$G(DGNEWPT)'=1 S DGPTSSN=$P($G(^DPT(DFN,0)),U,9)
 I +$G(DGNEWPT)=1 S DGPTSSN=$TR(DGPTSSN,"-","")
 I DGNPSSN=DGPTSSN D  Q
 .S DGREC(1)=1
 .S DGREC(2)="Security regulations prohibit computer access to your own medical record."
 Q
MSG(DGDUZ) ;Send Missing SSN in New Person file message to mailgroup
 ;Input:  DGDUZ - New Person (#200) file IEN (Required)
 ;
 N DGNPERR,DGNPNAME,DGTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
 S DGNPNAME=$$GET1^DIQ(200,DGDUZ_",",.01,"","DGNPERR")
 S XMSUB="MISSING SSN IN NEW PERSON FILE"
 S DGTEXT(1)="The following NEW PERSON record does not contain a Social Security Number."
 S DGTEXT(2)="This is required to access PATIENT file entries."
 S DGTEXT(3)=""
 S DGTEXT(4)=$S(DGNPNAME'="":DGNPNAME,1:"UNKNOWN")
 S DGTEXT(5)="NEW PERSON (#200) File Internal Entry Number (DUZ):  "_+DGDUZ
 S DGTEXT(6)=""
 S DGTEXT(7)="This message has been sent to DG MISSING NEW PERSON SSN mail group."
 S DGTEXT(8)="Please take appropriate action."
 S XMTEXT="DGTEXT("
 S XMDUZ=$S(DGNPNAME'="":DGNPNAME,1:.5)
 S XMY("G.DG MISSING NEW PERSON SSN")=""
 S XMCHAN=1
 D ^XMD
 Q
SENS(DGSENS,DFN,DGDUZ,DDS,DGSENFLG) ;Determine if sensitive record
 ;Input:
 ;  DGSENS - Array name passed by reference
 ;  DFN - Patient (#2) file IEN (Required)
 ;  DGDUZ - New Person (#200) file IEN
 ;  DDS - Screenman variable
 ;  DGSENFLG - If defined, patient record sensitivity not checked
 ;
 ;Output:
 ;  DGSENS(1)=0 - Record is not sensitive or DGSENFLG set
 ;           =1 - Sensitive record and user holds DG SENSITIVITY key
 ;              - Employee and user holds DG SECURITY OFFICER key
 ;           =2 - Sensitive record and user does not hold key
 ;              - Employee and user does not hold key
 ;           =-1 - Required input variable not defined
 ;  If 1, 2 or -1, array will contain error/display message
 ;
 N DGMSG,DGA1,DG1,DGDATE,DGLNE,DGT,DGTIME,DGEMPLEE
 ;Patient file DFN must be defined.
 I '$D(DFN) D  Q 
 .S DGSENS(1)=-1
 .S DGSENS(2)="DFN not defined."
 S DGSENS(1)=0
 I $D(DGSENFLG) Q
 ;Determine if patient is employee
 S DGEMPLEE=$$EMPL(DFN)
 ;Quit if not an employee & not found in DG Security Log file
 I 'DGEMPLEE,('$D(^DGSL(38.1,+DFN,0))) Q
 ;Quit if not an employee and not flagged as sensitive
 I 'DGEMPLEE,($P($G(^DGSL(38.1,+DFN,0)),U,2)'=1) Q
 ;DUZ & user name must be defined
 S DGMSG=$S('$G(DGDUZ):"user code",'$D(^VA(200,DGDUZ,0)):"user name",1:"")
 I DGMSG'="" D  Q
 .S DGSENS(1)=-1
 .S DGSENS(2)="Your "_DGMSG_" is undefined.  This must be defined to access"
 .S DGSENS(3)=" a restricted patient record."
 S DGSENS(1)=1
 ;Inpatient check - no longer used (kept for future reference)
 ;D H^DGUTL S DGT=DGTIME D ^DGPMSTAT
 S DGSENS(2)="***WARNING***"
 I $G(DDS)'="" S DGSENS(2)=DGSENS(2)_"  ***RESTRICTED RECORD***"
 I $G(DDS)="" S DGSENS(3)="***RESTRICTED RECORD***"
 I DGEMPLEE,('$D(^XUSEC("DG SECURITY OFFICER",+$G(DGDUZ)))) D  Q
 .S DGSENS(1)=2
 .D PRIV
 I '$D(^XUSEC("DG SENSITIVITY",+$G(DGDUZ))) D
 .S DGSENS(1)=2
 .D PRIV
 Q
PRIV ;Privacy Act statement for DGSENS array
 I $G(DDS)="" S DGSENS(4)=""
 S DGSENS(5)="1. STOP"
 S DGSENS(6)="2. Confirm you need access to this Restricted patient record"
 S DGSENS(7)=""
 S DGSENS(8)="This record is protected by the Privacy Act of 1974 and the Health"
 S DGSENS(9)="Insurance Portability and Accountability Act (HIPAA) Privacy Rule."
 S DGSENS(10)=" * Access to this patient record is tracked and monitored."
 S DGSENS(11)=" * You must have need for this record to accomplish officially"
 S DGSENS(12)="  authorized and assigned duties, such as direct patient care, to"
 S DGSENS(13)="  proceed."
 S DGSENS(14)=" * You must provide justification for your access upon request."
 S DGSENS(15)=" * Failure to comply may result in disciplinary or adverse action up to"
 S DGSENS(16)="  and including removal from Federal service, and civil and criminal"
 S DGSENS(17)="  penalties."
 I $G(DDS)="" S DGSENS(18)=""
 Q
EMPL(DFN,DGCHELIG) ;Does patient have any eligibility codes equal to
 ;                EMPLOYEE
 ;Input:
 ;       DFN - Patient (#2) file IEN (required).
 ;  DGCHELIG - Flags to determine mode of execution (optional).
 ;             Value of the parameter can contain any combination
 ;             of the following characters:
 ;               "P" - check primary eligibility code
 ;               "S" - check secondary eligibility codes
 ;
 ;             If this parameter is either not defined or set to an
 ;             illegal value, the value of "PS" will be assumed.
 ;Output:
 ;         1 - Patient has EMPLOYEE as an eligibility code
 ;         0 - Patient doesn't have EMPLOYEE as an eligibility code
 ;
 ;Notes: EMPLOYEE is entry 14 in the MAS ELIGIBILITY CODE file (#8.1)
 N DGELIG,DGEMPLEE
 S DGEMPLEE=0
 I $G(DGCHELIG)'["P",$G(DGCHELIG)'["S" S DGCHELIG="PS"
 ;Check primary eligibility
 I DGCHELIG["P" D
 .S DGELIG=+$G(^DPT(DFN,.36))
 .I $D(^DIC(8,"D",14,DGELIG)) S DGEMPLEE=1
 ;Check secondary eligibilities (if needed)
 I DGCHELIG["S",'DGEMPLEE D
 .S DGELIG=0
 .F  S DGELIG=+$O(^DPT("AEL",DFN,DGELIG)) Q:'DGELIG  I $D(^DIC(8,"D",14,DGELIG)) S DGEMPLEE=1 Q
 Q DGEMPLEE