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

ORQPT2.m

Go to the documentation of this file.
  1. ORQPT2 ;HIRMFO/DAD - Patient Look-Up Security Check and Notification ;Jun 13, 2019@11:43
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**377**;Dec 17, 1997;Build 582
  1. ;
  1. EN1(ORDFN) ;
  1. ; Sensitive Patient record check
  1. ; Input
  1. ; ORDFN = 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(ORDFN),2,"I")
  1. ;
  1. EN2(ORDFN) ;
  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. ; ORDFN = Pointer to the Patient file (#2)
  1. ; Output
  1. ; None
  1. ;
  1. I $S($G(ORDFN)'>0:1,$G(DUZ)'>0:1,1:'$$EN1(ORDFN)) Q
  1. ;
  1. N DFN,DG1,DGA1,DGT,DGXFR0
  1. N ORINPT,ORINVNOW,ORMAILGR,ORNOW,OROPT
  1. N X,XQOPT
  1. ;
  1. D OP^XQCHK
  1. S OROPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
  1. S ORNOW=$E($$NOW^XLFDT,1,12)
  1. S DFN=ORDFN,DGT=ORNOW D EN^DGPMSTAT S ORINPT=$S(DG1:"y",1:"n")
  1. S ORMAILGR=$$GET1^DIQ(43,1,509)
  1. ;
  1. I ORINPT="n",'$D(^XUSEC("DG SENSITIVITY",DUZ)),ORMAILGR]"" D
  1. . N ORTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
  1. . S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
  1. . S XMY("G."_ORMAILGR)=""
  1. . S XMTEXT="ORTEXT("
  1. . S XMDUZ=DUZ
  1. . S XMCHAN=1
  1. . S ORTEXT(1)="The following sensitive patient record has been accessed:"
  1. . S ORTEXT(2)=""
  1. . S ORTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,ORDFN,.01)
  1. . S ORTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,ORDFN,.09)
  1. . S ORTEXT(5)=" Option Used : "_$P(OROPT,U,2)
  1. . D ^XMD
  1. . Q
  1. ;
  1. F L +^DGSL(38.1,ORDFN):1 Q:$T
  1. ;
  1. I '$D(^DGSL(38.1,ORDFN)) D
  1. . N ORFDA,ORIEN,ORMSG
  1. . S ORFDA(38.1,"+1,",.01)=ORDFN
  1. . S ORIEN(1)=ORDFN
  1. . D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
  1. . Q
  1. F S ORINVNOW=9999999.9999-ORNOW Q:'$D(^DGSL(38.1,ORDFN,"D",ORINVNOW)) S ORNOW=ORNOW+.00001
  1. N ORFDA,ORIEN,ORMSG
  1. S ORFDA(38.11,"+1,"_ORDFN_",",.01)=ORNOW
  1. S ORFDA(38.11,"+1,"_ORDFN_",",2)=DUZ
  1. S ORFDA(38.11,"+1,"_ORDFN_",",3)=$P(OROPT,U,2)
  1. S ORFDA(38.11,"+1,"_ORDFN_",",4)=ORINPT
  1. S ORIEN(1)=ORINVNOW
  1. D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
  1. ;
  1. L -^DGSL(38.1,ORDFN)
  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-6 nonrepeating characters consisting
  1. ; of the letters C,W,A,D,P,L. 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. ; ORLST 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 ORLST="cwad"
  1. S CTR=0
  1. F S CTR=$O(^TMP("TIUPPCV",$J,CTR)) Q:(CTR'>0)!(ORLST?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 ORLST=$TR(ORLST,$C($A(ACRN)+32),ACRN)
  1. . Q
  1. K ^TMP("TIUPPCV",$J)
  1. ; Remove any remaining lower case items
  1. S ORLST=$TR(ORLST,"cwad")
  1. S ORLST=ORLST_$$POSTSHRT^WVRPCOR(DFN)
  1. Q ORLST