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

DGSEC.m

Go to the documentation of this file.
  1. DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
  1. ;;5.3;Registration;**32,46,197,214,249,281,352,391,425,582,769,796,964,1130**;Aug 13, 1993;Build 7
  1. ;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. ;Entry point from DPTLK
  1. I +$G(Y)=+$G(^DISV(DUZ,"^DPT(")),$G(DPTBTDT) K DPTBTDT Q
  1. N DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1
  1. ;Y=Patient file DFN
  1. S DGY=Y
  1. ;OWNREC^DGSEC4 parameters:
  1. ; DGREC = output array passed by reference
  1. ; DGY = Patient file DFN
  1. ; DUZ = New Person file IEN
  1. ; 1=generate error msg
  1. ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry
  1. ; DGPTSSN - set to patient's SSN when adding new Patient file entry
  1. ; X=Patient's SSN from DPTLK2
  1. I $G(DGNEWPT)=1 S DGPTSSN=X
  1. D OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
  1. S Y=DGY
  1. I DGREC(1)=1!(DGREC(1)=2) D G Q
  1. .S Y=-1
  1. .D DISP(.DGREC)
  1. .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
  1. ;SENS^DGSEC4 parameters:
  1. ; DGSENS = output array passed by reference
  1. ; Y = Patient fileDFN
  1. ; DUZ = New Person file IEN
  1. ; DDS - Screenman variable
  1. ; DGSENFLG - If defined, patient record sensitivity not checked
  1. D SENS^DGSEC4(.DGSENS,+Y,DUZ,$G(DDS),.DGSENFLG)
  1. ;DUZ must be defined to access a sensitive record
  1. I DGSENS(1)=-1 D G Q
  1. .S Y=-1
  1. .D DISP(.DGSENS)
  1. I DGSENS(1)=0 D G Q
  1. .;DG*5.3*964 hook to call VistA Security Remediation Audit solution VAS
  1. .I $$GET1^DIQ(46.5,1,.02,"I") D SELAUD^DGAUDIT2(2,$G(DGY),"INQUIRY",$G(DGOPT))
  1. ;Get option name for DG Security Log file and bulletin
  1. D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
  1. I DGSENS(1)=1 D
  1. .I DIC(0)["E" D
  1. ..W $C(7)
  1. ..D DISP(.DGSENS)
  1. .I Y>0 D
  1. ..;Parameters: DFN,DUZ,,Option name^Menu text
  1. ..D SETLOG1(+Y,DUZ,,DGOPT)
  1. I DGSENS(1)=2 D
  1. .I DIC(0)["E" D
  1. ..W $C(7)
  1. ..D DISP2V
  1. ..D NOTCE1
  1. .I Y>0 D
  1. ..D SETLOG1(+Y,DUZ,,DGOPT)
  1. ..;Parameters: DFN,DUZ,Option name^Menu text,message array
  1. ..D BULTIN1(+Y,DUZ,DGOPT,.DGMSG)
  1. ..I $D(DGSM),DIC(0)["E" D DISP(.DGMSG)
  1. D Q
  1. Q
  1. ;
  1. REC ;DPTLK2 entry point when adding new Patient file record
  1. ;Input: X=Patient's SSN
  1. ;Output: DGREC=1 (adding own record or SSN not defined) or 0
  1. ;
  1. ;Parameters: DGREC=output array
  1. ; DUZ
  1. ; 1 - generate error msg
  1. ; DGNEWPT = 1 (adding new Patient (#2) file record
  1. ; DGPTSSN = X (Patient's SSN)
  1. N DGPTSSN
  1. S DGPTSSN=X
  1. D OWNREC^DGSEC4(.DGREC,,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
  1. I DGREC(1)=1!(DGREC(1)=2) D
  1. .D DISP(.DGREC)
  1. .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
  1. S DGREC=+DGREC(1)
  1. I DGREC=2 S DGREC=1
  1. Q
  1. SETLOG ;Entry point for DBIA #2242
  1. ;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text
  1. D SETLOG1(Y,DUZ,DG1,DGOPT)
  1. D Q
  1. Q
  1. BULTIN ;Entry point for DBIA #2242
  1. ;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text
  1. D BULTIN1(Y,DUZ,DGOPT)
  1. Q
  1. SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1)
  1. ;Input:
  1. ; DFN - Patient (#2) file DFN (Required)
  1. ; DGDUZ - New Person (#200) file IEN
  1. ; DG1 - Inpatient or Outpatient (Optional)
  1. ; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional)
  1. ;
  1. N DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT
  1. ;DG/582
  1. I $G(VALM("TITLE"))="Dependents Module" Q
  1. ;Lock global
  1. LOCK L +^DGSL(38.1,+DFN):1 G:'$T LOCK
  1. ;Add new entry for patient if not found
  1. I '$D(^DGSL(38.1,+DFN,0)) D
  1. .S ^DGSL(38.1,+DFN,0)=+DFN
  1. .S ^DGSL(38.1,"B",+DFN,+DFN)=""
  1. .S $P(^DGSL(38.1,0),U,3)=+DFN
  1. .S $P(^DGSL(38.1,0),U,4)=$P(^DGSL(38.1,0),U,4)+1
  1. .;Determine if entry is automatically sensitive
  1. .N ELIG,FLAG,X
  1. .S FLAG=0
  1. .S X=$S($D(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"")
  1. .I $D(^DG(391,+X,0)),$P(^(0),"^",4) S FLAG=1
  1. .I 'FLAG S ELIG=0 F S ELIG=$O(^DPT(+DFN,"E",ELIG)) Q:'ELIG D Q:FLAG
  1. ..S X=$G(^DIC(8,ELIG,0))
  1. ..I $P(X,"^",12) S FLAG=1
  1. .S $P(^DGSL(38.1,+DFN,0),"^",2)=FLAG
  1. .;Date/time sensitivity was set
  1. .S $P(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT()
  1. ;determine if an inpatient
  1. D H^DGUTL
  1. S DGT=DGTIME
  1. I $G(DG1)="" D ^DGPMSTAT
  1. ;get option name
  1. I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
  1. SETUSR S DGDTE=9999999.9999-DGTIME I $D(^DGSL(38.1,+DFN,"D",DGDTE,0)) S DGTIME=DGTIME+.00001 G SETUSR
  1. S:'$D(^DGSL(38.1,+DFN,"D",0)) ^(0)="^38.11DA^^" S ^DGSL(38.1,+DFN,"D",DGDTE,0)=DGTIME_U_DGDUZ_U_$P(DGOPT,U,2)_U_$S(DG1:"y",1:"n"),$P(^(0),U,3,4)=DGDTE_U_($P(^DGSL(38.1,+DFN,"D",0),U,4)+1)
  1. S ^DGSL(38.1,"AD",DGDTE,+DFN)=""
  1. S ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)=""
  1. L -^DGSL(38.1,+DFN)
  1. ;
  1. I $$GET1^DIQ(46.5,1,.02,"I") D SELAUD^DGAUDIT2(2,$G(DFN),"INQUIRY",$G(DGOPT))
  1. ;
  1. Q
  1. Q K DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT
  1. N DGTEST S DGTEST=^%ZOSF("TEST")
  1. I DIC(0)["E",Y>0 D
  1. .S X="DGPFAPI" X DGTEST I $T D ;Patient Record Flags check/display
  1. ..N DGPFSAVY S DGPFSAVY=Y
  1. ..D DISPPRF^DGPFAPI(Y) S Y=DGPFSAVY K DGPFSAVY
  1. .S X="A7RDPACT" X DGTEST I $T D ^A7RDPACT ;NDBI
  1. .S X="GMRPNCW" X DGTEST I $T S DPTSAVY=Y D ENPAT^GMRPNCW S Y=DPTSAVY K DPTSAVY ; CWAD
  1. .S X="MPRCHK" X DGTEST I $T D EN^MPRCHK(Y) ; MPR
  1. Q
  1. ;
  1. BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin
  1. ;
  1. ;Input: DFN = Patient file IEN
  1. ; DGDUZ = New Person (#200) file IEN
  1. ; DGOPT = Option (#19) file Name (#.01)^Menu text
  1. ; DGMSG = Message array (Optional)
  1. ;
  1. N DGEMPLEE,XMSUB,XQOPT
  1. ;DG/582
  1. I $G(VALM("TITLE"))="Dependents Module" Q
  1. K DGB I $D(^DG(43,1,"NOT")),+$P(^("NOT"),U,10) S DGB=10
  1. Q:'$D(DGB) S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
  1. S DGB=+$P($G(^DG(43,1,"NOT")),U,DGB) Q:'DGB
  1. S DGB=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR") Q:'$L(DGB)
  1. ;S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB)
  1. I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
  1. N XMB,XMY,XMY0,XMZ
  1. S XMB="DG SENSITIVITY",XMB(1)=$P(^DPT(+DFN,0),U)
  1. S DGEMPLEE=$$EMPL^DGSEC4(+DFN)
  1. I DGEMPLEE=1 S XMB(1)=XMB(1)_" (Employee)"
  1. S XMB(2)=$P(^DPT(+DFN,0),U,9),XMB(3)=$P(DGOPT,U,2),XMY("G."_DGB)=""
  1. N Y S Y=$$NOW^XLFDT() X ^DD("DD") S XMB(4)=Y
  1. D SEND(.XMB,.XMY)
  1. S DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer."
  1. Q
  1. ;
  1. SEND(XMB,XMY) ;Queue mail bulletin
  1. ;Input: XMB,XMY=Mailman bulletin parameters
  1. ;
  1. D ^XMB
  1. Q
  1. ;
  1. DISP(ARRAY) ;Display message text to screen
  1. ;Input: Array containg message text
  1. ;
  1. I '$D(ARRAY) Q
  1. I DIC(0)'["E" Q
  1. I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY S X=0 X ^%ZOSF("RM")
  1. N DGI,DGWHERE
  1. I '$D(DDS) W !!
  1. F DGI=1:0 S DGI=$O(ARRAY(DGI)) Q:'DGI D
  1. .W ARRAY(DGI),!
  1. Q
  1. ;
  1. NOTCE1 W:'$D(DDS) ! W "Do you want to continue accessing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D W:'$D(DDS) !! W "Enter 'YES' to continue accessing, or 'NO' to quit accessing this record." W:$D(DDS) ! G NOTCE1
  1. .I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY
  1. Q
  1. ;
  1. LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array
  1. ;PDX plans to use this - remember to NEW DIC before ^XMD call
  1. ; Input - None
  1. ; Output - XMY("G.mailgroupname")="" if field #509 is defined
  1. ; where mailgroupname is text value of mail group
  1. ; Returns: 0 - Ok
  1. ; -1^errortext - if can't find mail group
  1. ;
  1. N DGB,DGERR,DGM
  1. S DGERR=0
  1. S DGB=+$P($G(^DG(43,1,"NOT")),"^",10)
  1. S DGM=$$GET1^DIQ(3.8,DGB,.01,"","","ZERR")
  1. I '$D(DGM) S DGERR="-1^No/Bad Field #509 entry in File #43" G QTLOADX
  1. S XMY("G."_DGM)="" ; pass mailgroup
  1. QTLOADX Q DGERR
  1. ;
  1. DISP2V ;Display message text to screen for Vista
  1. N DGLNE
  1. S DGSENS(1)=1
  1. S DGSENS(2)=" ***WARNING*** "
  1. S DGSENS(3)=" ***RESTRICTED RECORD*** "
  1. S $P(DGLNE,"* ",40)=""
  1. S DGSENS(4)=DGLNE
  1. S DGSENS(5)="* 1. STOP *"
  1. S DGSENS(6)="* 2. Confirm you need access to this Restricted patient record *"
  1. S DGSENS(7)="* *"
  1. S DGSENS(8)="* This record is protected by the Privacy Act of 1974 and the Health *"
  1. S DGSENS(9)="* Insurance Portability and Accountability Act (HIPAA) Privacy Rule. *"
  1. S DGSENS(10)="* * Access to this patient record is tracked and monitored. *"
  1. S DGSENS(11)="* * You must have need for this record to accomplish officially *"
  1. S DGSENS(12)="* authorized and assigned duties, such as direct patient care, to *"
  1. S DGSENS(13)="* proceed. *"
  1. S DGSENS(14)="* * You must provide justification for your access upon request. *"
  1. S DGSENS(15)="* * Failure to comply may result in disciplinary or adverse action up to *"
  1. S DGSENS(16)="* and including removal from Federal service, and civil and criminal *"
  1. S DGSENS(17)="* penalties. *"
  1. I $G(DDS)="" S DGSENS(18)=DGLNE
  1. D DISP(.DGSENS)
  1. Q