source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORQPT2.m@ 760

Last change on this file since 760 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1ORQPT2 ; HIRMFO/DAD-Patient Look-Up Security Check and Notification ;1/31/97 07:57
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3 ;
4EN1(ORDFN) ;
5 ; Sensitive Patient record check
6 ; Input
7 ; ORDFN = Pointer to the Patient file (#2)
8 ; Output
9 ; 0 - Patient record IS NOT sensitive
10 ; 1 - Patient record IS sensitive
11 ;
12 Q ''$$GET1^DIQ(38.1,+$G(ORDFN),2,"I")
13 ;
14EN2(ORDFN) ;
15 ; Update DG Security Log file (#38.1) and sends
16 ; the 'Restricted Patient Accessed' bulletin to the
17 ; mailgroup specified in the 'Sensitive Rec Accessed
18 ; Group' field (43,509)
19 ; Input
20 ; ORDFN = Pointer to the Patient file (#2)
21 ; Output
22 ; None
23 ;
24 I $S($G(ORDFN)'>0:1,$G(DUZ)'>0:1,1:'$$EN1(ORDFN)) Q
25 ;
26 N DFN,DG1,DGA1,DGT,DGXFR0
27 N ORINPT,ORINVNOW,ORMAILGR,ORNOW,OROPT
28 N X,XQOPT
29 ;
30 D OP^XQCHK
31 S OROPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
32 S ORNOW=$E($$NOW^XLFDT,1,12)
33 S DFN=ORDFN,DGT=ORNOW D EN^DGPMSTAT S ORINPT=$S(DG1:"y",1:"n")
34 S ORMAILGR=$$GET1^DIQ(43,1,509)
35 ;
36 I ORINPT="n",'$D(^XUSEC("DG SENSITIVITY",DUZ)),ORMAILGR]"" D
37 . N ORTEXT,XMCHAN,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
38 . S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
39 . S XMY("G."_ORMAILGR)=""
40 . S XMTEXT="ORTEXT("
41 . S XMDUZ=DUZ
42 . S XMCHAN=1
43 . S ORTEXT(1)="The following sensitive patient record has been accessed:"
44 . S ORTEXT(2)=""
45 . S ORTEXT(3)=" Patient Name: "_$$GET1^DIQ(2,ORDFN,.01)
46 . S ORTEXT(4)=" Soc Sec Num : "_$$GET1^DIQ(2,ORDFN,.09)
47 . S ORTEXT(5)=" Option Used : "_$P(OROPT,U,2)
48 . D ^XMD
49 . Q
50 ;
51 F L +^DGSL(38.1,ORDFN):1 Q:$T
52 ;
53 I '$D(^DGSL(38.1,ORDFN)) D
54 . N ORFDA,ORIEN,ORMSG
55 . S ORFDA(38.1,"+1,",.01)=ORDFN
56 . S ORIEN(1)=ORDFN
57 . D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
58 . Q
59 F S ORINVNOW=9999999.9999-ORNOW Q:'$D(^DGSL(38.1,ORDFN,"D",ORINVNOW)) S ORNOW=ORNOW+.00001
60 N ORFDA,ORIEN,ORMSG
61 S ORFDA(38.11,"+1,"_ORDFN_",",.01)=ORNOW
62 S ORFDA(38.11,"+1,"_ORDFN_",",2)=DUZ
63 S ORFDA(38.11,"+1,"_ORDFN_",",3)=$P(OROPT,U,2)
64 S ORFDA(38.11,"+1,"_ORDFN_",",4)=ORINPT
65 S ORIEN(1)=ORINVNOW
66 D UPDATE^DIE("","ORFDA","ORIEN","ORMSG")
67 ;
68 L -^DGSL(38.1,ORDFN)
69 ;
70 S X="MPRCHK" X ^%ZOSF("TEST") I $T D EN^MPRCHK(ORDFN)
71 ;
72 Q
73 ;
74CWAD(DFN) ;
75 ; Crisis notes, clinical Warnings, Allergies, advance Directives
76 ; Input:
77 ; DFN = A Patient file (#2) IEN
78 ; Output:
79 ; A string of 0-4 nonrepeating characters consisting
80 ; of the letters C,W,A,D. The string will be returned
81 ; with the letters in the order shown.
82 ;
83 I $G(DFN)'>0 Q ""
84 N ACRN,CTR,ORLST,MSG
85 D ENCOVER^TIUPP3(DFN)
86 ; ORLST initialized with lower case 'cwad' to generate
87 ; correct ordering of letters. Lower case letter indicates
88 ; that the patient does not have that item. Upper case
89 ; indicates that the patient has the item.
90 S ORLST="cwad"
91 S CTR=0
92 F S CTR=$O(^TMP("TIUPPCV",$J,CTR)) Q:(CTR'>0)!(ORLST?4U) D
93 . S ACRN=$P($G(^TMP("TIUPPCV",$J,CTR)),U,2)
94 . ; If patient has item, convert item to uppercase
95 . I "^C^W^A^D^"[(U_ACRN_U) S ORLST=$TR(ORLST,$C($A(ACRN)+32),ACRN)
96 . Q
97 K ^TMP("TIUPPCV",$J)
98 ; Remove any remaining lower case items
99 S ORLST=$TR(ORLST,"cwad")
100 Q ORLST
Note: See TracBrowser for help on using the repository browser.