source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGSEC.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1DGSEC ;ALB/RMO - MAS Patient Look-up Security Check ; 3/24/04 7:53pm
2 ;;5.3;Registration;**32,46,197,214,249,281,352,391,425,582**;Aug 13, 1993
3 ;
4 ;Entry point from DPTLK
5 N DFN,DGANS,DGMSG,DGOPT,DGPTSSN,DGREC,DGSENS,DGY,DX,DY,%,DG1
6 ;Y=Patient file DFN
7 S DGY=Y
8 ;OWNREC^DGSEC4 parameters:
9 ; DGREC = output array passed by reference
10 ; DGY = Patient file DFN
11 ; DUZ = New Person file IEN
12 ; 1=generate error msg
13 ; DGNEWPT - set to 1 in DPTLK2 when adding new Patient (#2) file entry
14 ; DGPTSSN - set to patient's SSN when adding new Patient file entry
15 ; X=Patient's SSN from DPTLK2
16 I $G(DGNEWPT)=1 S DGPTSSN=X
17 D OWNREC^DGSEC4(.DGREC,+DGY,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
18 S Y=DGY
19 I DGREC(1)=1!(DGREC(1)=2) D G Q
20 .S Y=-1
21 .D DISP(.DGREC)
22 .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
23 ;SENS^DGSEC4 parameters:
24 ; DGSENS = output array passed by reference
25 ; Y = Patient fileDFN
26 ; DUZ = New Person file IEN
27 ; DDS - Screenman variable
28 ; DGSENFLG - If defined, patient record sensitivity not checked
29 D SENS^DGSEC4(.DGSENS,+Y,DUZ,$G(DDS),.DGSENFLG)
30 ;DUZ must be defined to access a sensitive record
31 I DGSENS(1)=-1 D G Q
32 .S Y=-1
33 .D DISP(.DGSENS)
34 I DGSENS(1)=0 G Q
35 ;Get option name for DG Security Log file and bulletin
36 D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
37 I DGSENS(1)=1 D
38 .I DIC(0)["E" D
39 ..W $C(7)
40 ..D DISP(.DGSENS)
41 .I Y>0 D
42 ..;Parameters: DFN,DUZ,,Option name^Menu text
43 ..D SETLOG1(+Y,DUZ,,DGOPT)
44 I DGSENS(1)=2 D
45 .I DIC(0)["E" D
46 ..W $C(7)
47 ..D DISP(.DGSENS)
48 ..D NOTCE1
49 .I Y>0 D
50 ..D SETLOG1(+Y,DUZ,,DGOPT)
51 ..;Parameters: DFN,DUZ,Option name^Menu text,message array
52 ..D BULTIN1(+Y,DUZ,DGOPT,.DGMSG)
53 ..I $D(DGSM),DIC(0)["E" D DISP(.DGMSG)
54 D Q
55 Q
56 ;
57REC ;DPTLK2 entry point when adding new Patient file record
58 ;Input: X=Patient's SSN
59 ;Output: DGREC=1 (adding own record or SSN not defined) or 0
60 ;
61 ;Parameters: DGREC=output array
62 ; DUZ
63 ; 1 - generate error msg
64 ; DGNEWPT = 1 (adding new Patient (#2) file record
65 ; DGPTSSN = X (Patient's SSN)
66 N DGPTSSN
67 S DGPTSSN=X
68 D OWNREC^DGSEC4(.DGREC,,DUZ,1,$G(DGNEWPT),$G(DGPTSSN))
69 I DGREC(1)=1!(DGREC(1)=2) D
70 .D DISP(.DGREC)
71 .I $D(DDS) R !,"Please enter any key to continue.",DGANS:DTIME
72 S DGREC=+DGREC(1)
73 I DGREC=2 S DGREC=1
74 Q
75SETLOG ;Entry point for DBIA #2242
76 ;Input variables: Y=DFN,DUZ,DG1=Inpatient/outpatient indicator,DGOPT=Option name^Menu text
77 D SETLOG1(Y,DUZ,DG1,DGOPT)
78 D Q
79 Q
80BULTIN ;Entry point for DBIA #2242
81 ;Input variables: Y=DFN,DUZ,DGOPT=Option name^Menu text
82 D BULTIN1(Y,DUZ,DGOPT)
83 Q
84SETLOG1(DFN,DGDUZ,DG1,DGOPT) ;Adds/updates entry in DG Security Log file (38.1)
85 ;Input:
86 ; DFN - Patient (#2) file DFN (Required)
87 ; DGDUZ - New Person (#200) file IEN
88 ; DG1 - Inpatient or Outpatient (Optional)
89 ; DGOPT - Option (#19) file Name (#.01)^Menu text (Optional)
90 ;
91 N DGA1,DGDATE,DGDTE,DGT,DGTIME,XQOPT
92 ;DG/582
93 I $G(VALM("TITLE"))="Dependents Module" Q
94 ;Lock global
95LOCK L +^DGSL(38.1,+DFN):1 G:'$T LOCK
96 ;Add new entry for patient if not found
97 I '$D(^DGSL(38.1,+DFN,0)) D
98 .S ^DGSL(38.1,+DFN,0)=+DFN
99 .S ^DGSL(38.1,"B",+DFN,+DFN)=""
100 .S $P(^DGSL(38.1,0),U,3)=+DFN
101 .S $P(^DGSL(38.1,0),U,4)=$P(^DGSL(38.1,0),U,4)+1
102 .;Determine if entry is automatically sensitive
103 .N ELIG,FLAG,X
104 .S FLAG=0
105 .S X=$S($D(^DPT(+DFN,"TYPE")):+^("TYPE"),1:"")
106 .I $D(^DG(391,+X,0)),$P(^(0),"^",4) S FLAG=1
107 .I 'FLAG S ELIG=0 F S ELIG=$O(^DPT(+DFN,"E",ELIG)) Q:'ELIG D Q:FLAG
108 ..S X=$G(^DIC(8,ELIG,0))
109 ..I $P(X,"^",12) S FLAG=1
110 .S $P(^DGSL(38.1,+DFN,0),"^",2)=FLAG
111 .;Date/time sensitivity was set
112 .S $P(^DGSL(38.1,+DFN,0),"^",4)=$$NOW^XLFDT()
113 ;determine if an inpatient
114 D H^DGUTL
115 S DGT=DGTIME
116 I $G(DG1)="" D ^DGPMSTAT
117 ;get option name
118 I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
119SETUSR S DGDTE=9999999.9999-DGTIME I $D(^DGSL(38.1,+DFN,"D",DGDTE,0)) S DGTIME=DGTIME+.00001 G SETUSR
120 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)
121 S ^DGSL(38.1,"AD",DGDTE,+DFN)=""
122 S ^DGSL(38.1,"AU",+DFN,DGDUZ,DGDTE)=""
123 L -^DGSL(38.1,+DFN)
124 Q
125Q K DG1,DGDATE,DGDTE,DGLNE,DGMSG,DGOPT,DGSEN,DGTIME,DGY,XQOPT
126 N DGTEST S DGTEST=^%ZOSF("TEST")
127 I DIC(0)["E",Y>0 D
128 .S X="DGPFAPI" X DGTEST I $T D ;Patient Record Flags check/display
129 ..N DGPFSAVY S DGPFSAVY=Y
130 ..D DISPPRF^DGPFAPI(Y) S Y=DGPFSAVY K DGPFSAVY
131 .S X="A7RDPACT" X DGTEST I $T D ^A7RDPACT ;NDBI
132 .S X="GMRPNCW" X DGTEST I $T S DPTSAVY=Y D ENPAT^GMRPNCW S Y=DPTSAVY K DPTSAVY ; CWAD
133 .S X="MPRCHK" X DGTEST I $T D EN^MPRCHK(Y) ; MPR
134 Q
135 ;
136BULTIN1(DFN,DGDUZ,DGOPT,DGMSG) ;Generate sensitive record access bulletin
137 ;
138 ;Input: DFN = Patient file IEN
139 ; DGDUZ = New Person (#200) file IEN
140 ; DGOPT = Option (#19) file Name (#.01)^Menu text
141 ; DGMSG = Message array (Optional)
142 ;
143 N DGEMPLEE,XMSUB,XQOPT
144 ;DG/582
145 I $G(VALM("TITLE"))="Dependents Module" Q
146 K DGB I $D(^DG(43,1,"NOT")),+$P(^("NOT"),U,10) S DGB=10
147 Q:'$D(DGB) S XMSUB="RESTRICTED PATIENT RECORD ACCESSED"
148 S DGB=+$P($G(^DG(43,1,"NOT")),U,DGB) Q:'DGB
149 S DGB=$P($G(^XMB(3.8,DGB,0)),U) Q:'$L(DGB)
150 I $G(DGOPT)="" D OP^XQCHK S DGOPT=$S(+XQOPT<0:"^UNKNOWN",1:$P(XQOPT,U)_U_$P(XQOPT,U,2))
151 N XMB,XMY,XMY0,XMZ
152 S XMB="DG SENSITIVITY",XMB(1)=$P(^DPT(+DFN,0),U)
153 S DGEMPLEE=$$EMPL^DGSEC4(+DFN)
154 I DGEMPLEE=1 S XMB(1)=XMB(1)_" (Employee)"
155 S XMB(2)=$P(^DPT(+DFN,0),U,9),XMB(3)=$P(DGOPT,U,2),XMY("G."_DGB)=""
156 N Y S Y=$$NOW^XLFDT() X ^DD("DD") S XMB(4)=Y
157 D SEND(.XMB,.XMY)
158 S DGMSG(1)="NOTE: A bulletin will now be sent to your station security officer."
159 Q
160 ;
161SEND(XMB,XMY) ;Queue mail bulletin
162 ;Input: XMB,XMY=Mailman bulletin parameters
163 ;
164 D ^XMB
165 Q
166 ;
167DISP(ARRAY) ;Display message text to screen
168 ;Input: Array containg message text
169 ;
170 I '$D(ARRAY) Q
171 I DIC(0)'["E" Q
172 I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY S X=0 X ^%ZOSF("RM")
173 N DGI,DGWHERE
174 I '$D(DDS) W !!
175 F DGI=1:0 S DGI=$O(ARRAY(DGI)) Q:'DGI D
176 .S DGWHERE=(80-$L(ARRAY(DGI)))\2
177 .W ?DGWHERE,ARRAY(DGI),!
178 Q
179 ;
180NOTCE1 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
181 .I $D(DDS) D CLRMSG^DDS S DX=0,DY=DDSHBX+1 X DDXY
182 Q
183 ;
184LOADXMY() ;this adds the contents of field #509 of File #43 to the XMY array
185 ;PDX plans to use this - remember to NEW DIC before ^XMD call
186 ; Input - None
187 ; Output - XMY("G.mailgroupname")="" if field #509 is defined
188 ; where mailgroupname is text value of mail group
189 ; Returns: 0 - Ok
190 ; -1^errortext - if can't find mail group
191 ;
192 N DGB,DGERR
193 S DGERR=0
194 S DGB=+$P($G(^DG(43,1,"NOT")),"^",10)
195 I '$D(^XMB(3.8,DGB,0))#2 S DGERR="-1^No/Bad Field #509 entry in File #43" G QTLOADX
196 S XMY("G."_$P($G(^XMB(3.8,DGB,0)),"^",1))="" ; pass mailgroup
197QTLOADX Q DGERR
Note: See TracBrowser for help on using the repository browser.