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

DGQPT2.m

Go to the documentation of this file. 
  1. DGQPT2 ; HIRMFO/DAD-Patient Look-Up Security Check and Notification ;1/31/97  07:57
  1.  ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. EN1(DGDFN) ;
  1.  ; Sensitive Patient record check
  1.  ;  Input
  1.  ;   DGDFN = Pointer to the Patient file (#2)
  1.  ;  Output
  1.  ;   0 - Patient record IS NOT sensitive
  1.  ;   1 - Patient record IS sensitive
  1.  ;
  1.  Q ''$$GET1^DIQ(38.1,+$G(DGDFN),2,"I")
  1.  ;
  1. EN2(DGDFN) ;
  1.  ; Update DG Security Log file (#38.1) and sends
  1.  ; the 'Restricted Patient Accessed' bulletin to the
  1.  ; mailgroup specified in the 'Sensitive Rec Accessed
  1.  ; Group' field (43,509)
  1.  ;  Input
  1.  ;   DGDFN = Pointer to the Patient file (#2)
  1.  ;  Output
  1.  ;   None
  1.  ;
  1.  I $S($G(DGDFN)'>0:1,$G(DUZ)'>0:1,1:'$$EN1(DGDFN)) Q
  1.  ;
  1.  N DFN,DG1,DGA1,DGT,DGXFR0,DGINPT,DGINVNOW,DGMAILGR,DGNOW,DGOPT
  1.  N X,XQOPT
  1.  ;
  1.  D OP^XQCHK
  1.  S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
  1.  S DGNOW=$E($$NOW^XLFDT,1,12)
  1.  S DFN=DGDFN,DGT=DGNOW D EN^DGPMSTAT S DGINPT=$S(DG1:"y",1:"n")
  1.  S DGMAILGR=$$GET1^DIQ(43,1,509)
  1.  ;
  1.  I DGINPT="n",'$D(^XUSEC("DG SENSITIVITY",DUZ)),DGMAILGR]"" D
  1.  . N DGTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
  1.  . S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
  1.  . S XMY("G."_DGMAILGR)=""
  1.  . S XMTEXT="DGTEXT("
  1.  . S XMDUZ=DUZ
  1.  . S XMCHAN=1
  1.  . S DGTEXT(1)="The following sensitive patient record has been accessed:"
  1.  . S DGTEXT(2)=""
  1.  . S DGTEXT(3)="  Patient Name: "_$$GET1^DIQ(2,DGDFN,.01)
  1.  . S DGTEXT(4)="  Soc Sec Num : "_$$GET1^DIQ(2,DGDFN,.09)
  1.  . S DGTEXT(5)="  Option Used : "_$P(DGOPT,U,2)
  1.  . D ^XMD
  1.  . Q
  1.  ;
  1.  F  L +^DGSL(38.1,DGDFN):1 Q:$T
  1.  ;
  1.  I '$D(^DGSL(38.1,DGDFN)) D
  1.  . N DGFDA,DGIEN,DGMSG
  1.  . S DGFDA(38.1,"+1,",.01)=DGDFN
  1.  . S DGIEN(1)=DGDFN
  1.  . D UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
  1.  . Q
  1.  F  S DGINVNOW=9999999.9999-DGNOW Q:'$D(^DGSL(38.1,DGDFN,"D",DGINVNOW))  S DGNOW=DGNOW+.00001
  1.  N DGFDA,DGIEN,DGMSG
  1.  S DGFDA(38.11,"+1,"_DGDFN_",",.01)=DGNOW
  1.  S DGFDA(38.11,"+1,"_DGDFN_",",2)=DUZ
  1.  S DGFDA(38.11,"+1,"_DGDFN_",",3)=$P(DGOPT,U,2)
  1.  S DGFDA(38.11,"+1,"_DGDFN_",",4)=DGINPT
  1.  S DGIEN(1)=DGINVNOW
  1.  D UPDATE^DIE("","DGFDA","DGIEN","DGMSG")
  1.  ;
  1.  L -^DGSL(38.1,DGDFN)
  1.  ;
  1.  S X="MPRCHK" X ^%ZOSF("TEST") I $T D EN^MPRCHK(DGDFN)
  1.  ;
  1.  Q
  1.  ;
  1. CWAD(DFN) ;
  1.  ; Crisis notes, clinical Warnings, Allergies, advance Directives
  1.  ;  Input:
  1.  ;   DFN = A Patient file (#2) IEN
  1.  ;  Output:
  1.  ;   A string of 0-4 nonrepeating characters consisting
  1.  ;   of the letters C,W,A,D.  The string will be returned
  1.  ;   with the letters in the order shown.
  1.  ;
  1.  I $G(DFN)'>0 Q ""
  1.  N ACRN,CTR,ORLST,MSG
  1.  D ENCOVER^TIUPP3(DFN)
  1.  ; DGLST initialized with lower case 'cwad' to generate
  1.  ; correct ordering of letters.  Lower case letter indicates
  1.  ; that the patient does not have that item.  Upper case
  1.  ; indicates that the patient has the item.
  1.  S DGLST="cwad"
  1.  S CTR=0
  1.  F  S CTR=$O(^TMP("TIUPPCV",$J,CTR)) Q:(CTR'>0)!(DGLST?4U)  D
  1.  . S ACRN=$P($G(^TMP("TIUPPCV",$J,CTR)),U,2)
  1.  . ; If patient has item, convert item to uppercase
  1.  . I "^C^W^A^D^"[(U_ACRN_U) S DGLST=$TR(DGLST,$C($A(ACRN)+32),ACRN)
  1.  . Q
  1.  K ^TMP("TIUPPCV",$J)
  1.  ; Remove any remaining lower case items
  1.  S DGLST=$TR(DGLST,"cwad")
  1.  Q DGLST