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;PIMS;**32,46,197,214,249,281,352,391,425,582,1002,1008,1009,1011,1015,1016**;JUN 30, 2012;Build 20
  1.  ;IHS/ANMC/LJF  9/7/2000  added chart # to bulletin
  1.  ;              8/31/2001 added code to track all patients per parameter
  1.  ;             10/02/2003 VA added code to add patient but not setting of ANS xref
  1.  ;IHS/ITSC/WAR 3/17/2005 Fix dealing with calls from other apps/pkgs
  1.  ;IHS/OIT/LJF 08/31/2007 PATCH 1008 added code to check if user is restrcited from accessing a record
  1.  ;
  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.  ;
  1.  ;IHS/OIT/LJF 08/31/2007 PATCH 1008
  1.  ; check if users is restricted from accessing this patient's record
  1.  I $$STATUS^BDGSPT2(DUZ,DGY,1)["RESTRICTED ACCESS" D  Q
  1.  . S Y=-1
  1.  . NEW MSG S MSG(2)="Sorry, you are restricted from accessing this patient's record."
  1.  . S MSG(3)="If you have questions, please contact your HIM department."
  1.  . D DISP(.MSG)
  1.  ; end of PATCH 1008 code
  1.  ;
  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 G Q  ;IHS/ANMC/LJF 8/31/2001
  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.  ;
  1.  ;IHS/ANMC/LJF 8/31/2001 if site parameter says log all patients
  1.  ;                       if set to 2, means non-sensitive so log anyway
  1.  ;IHS/ITSC/WAR 3/17/2005 Fix dealing with calls from other apps/pkgs
  1.  ;                       REM'd next 3 lines 
  1.  ;I DGSENS(1)[0 D  G Q
  1.  ;. I DGSENS(1)=0 Q:$$GET1^DIQ(43,1,9999999.01)'="YES"  ;track all not on
  1.  ;. S DGSENS(1)=0                                       ;reset if = 0^0
  1.  I DGSENS(1)=0 D  G Q
  1.  . I $$GET1^DIQ(43,1,9999999.01)'="YES"&('$P($G(^DGSL(38.1,+DGY,0)),U,2)) Q  ;track all not on.  End of 3/17/2005 modification cmi/maw 1/26/2010 PATCH 1011
  1.  . D SETLOG1(+Y,DUZ,,DGOPT)                            ;set log entry
  1.  ;IHS/ANMC/LJF 8/31/2001 end of new code
  1.  ;
  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 DISP(.DGSENS)
  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.  .I FLAG=0 S ^DGSL(38.1,"ANS",+DFN)=""  ;IHS/ITSC/LJF 10/02/2003
  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.  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 XMB(1)=XMB(1)_" (#"_$$HRCN^BDGF2(+DFN,DUZ(2))_")"  ;IHS/ANMC/LJF 9/7/2000
  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.  .S DGWHERE=(80-$L(ARRAY(DGI)))\2
  1.  .W ?DGWHERE,ARRAY(DGI),!
  1.  Q
  1.  ;
  1. NOTCE1 W:'$D(DDS) !! W "Do you want to continue processing this patient record" S %=2 D YN^DICN S:%<0!(%=2) Y=-1 I '% D  W:'$D(DDS) !! W "Enter 'YES' to continue processing, or 'NO' to quit processing 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