source: FOIAVistA/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVOA.m@ 1613

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1ANRVOA ; HOIFO/CED - User, Patient and Parameter specifics for Patient Review. ; [01-07-2003 12:19]
2 ;;4.0;VISUAL IMPAIRMENT SERVICE TEAM;**5**;AUG 21, 2003
3ADD(X) ; [Procedure] Adds to RESULTS
4 S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
5 Q
6 ;
7DELLST ; [Procedure] Delete list of parameters
8 D NDEL^XPAR(ENT,PAR,.ERR)
9 S:'$G(ERR) @RESULTS@(0)="1^All Instances Removed"
10 Q
11 ;
12DELPAR ; [Procedure] Delete single parameter value
13 D DEL^XPAR(ENT,PAR,INST,.ERR)
14 S:'$G(ERR) @RESULTS@(0)="1^Instance Deleted"
15 Q
16 ;
17ELECSIG ; [Procedure] Check Electronic Signature
18 N X
19 S X=DATA
20 S X1=$S($D(DUZ)[0:"",$D(^VA(200,DUZ,20))[0:"",1:$P(^(20),U,4))
21 I X1="" S @RESULTS@(0)="-1^Electronic Signature Not Found." Q
22 D HASH^XUSHSHP
23 I X1'=X S @RESULTS@(0)="0^Electronic Signature Incorrect." Q
24 S @RESULTS@(0)="1^Electronic Signature Verified."
25 Q
26 ;
27ENTVAL ; [Procedure] Return value of the entity
28 I ENT="SYS" S ENT=$$KSP^XUPARAM("WHERE")
29 E I ENT="DIV" S ENT=$$GET1^DIQ(4,DUZ(2)_",",.01)
30 E I ENT="USR" S ENT=$$GET1^DIQ(200,DUZ_",",.01)
31 E S ENT=$$GET1^DIQ(+$P(ENT,"(",2),+ENT_",",.01)
32 S @RESULTS@(0)=ENT
33 Q
34 ;
35FULLSSN(LST,ID) ; [Procedure] Return a list of patients matching Full SSN entered
36 N I,IEN
37 S (I,IEN)=0
38 F S IEN=$O(^DPT("SSN",ID,IEN)) Q:'IEN D
39 . S I=I+1,LST(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249
40 Q
41 ;
42GETHDR ; [Procedure] Returns common header format
43 S X=$$FIND1^DIC(8989.51,,"QX",PAR)
44 I X S @RESULTS@(0)=X_";8989.51^"_PAR
45 E S @RESULTS@(0)="-1^No such parameter ["_PAR_"]"
46 Q
47 ;
48GETLST ; [Procedure] Return all instances of a parameter
49 D GETLST^XPAR(.RET,ENT,PAR,"E",.ERR)
50 Q:$G(ERR,0)
51 S TMP="RET"
52 F S TMP=$Q(@TMP) Q:TMP="" D
53 .S @RESULTS@($O(@RESULTS@(""),-1)+1)=@TMP
54 S @RESULTS@(0)=$O(@RESULTS@(""),-1)
55 Q
56 ;
57GETPAR ; [Procedure] Returns external value for a parameter
58 S @RESULTS@(0)=$$GET^XPAR(ENT,PAR,INST,"E")
59 Q
60 ;
61GETWP ; [Procedure] Returns WP text for a parameter
62 D GETWP^XPAR(.RET,ENT,PAR,INST,.ERR)
63 Q:$G(ERR,0)
64 S TMP="RET"
65 F S TMP=$Q(@TMP) Q:TMP="" D
66 .S @RESULTS@($O(@RESULTS@(""),-1)+1)=@TMP
67 S @RESULTS@(0)=$O(@RESULTS@(""),-1)_U_INST
68 Q
69 ;
70LAST5(RESULTS,PTID) ; [Procedure] Get patients using last 5
71 N I,IEN,XREF
72 S (I,IEN)=0,XREF=$S($L(PTID)=5:"BS5",1:"BS")
73 F S IEN=$O(^DPT(XREF,PTID,IEN)) Q:'IEN D
74 .S I=I+1,RESULTS(I)=IEN_U_$P(^DPT(IEN,0),U)_U_$$DOB^DPTLK1(IEN,2)_U_$$SSN^DPTLK1(IEN) ; DG249
75 Q
76 ;
77LISTALL(RESULTS,FROM,DIR) ; [Procedure] Pt List
78 N I,IEN,CNT S CNT=44,I=0
79 F S FROM=$O(^DPT("B",FROM),DIR) Q:FROM="" D Q:I=CNT
80 .S IEN=0 F S IEN=$O(^DPT("B",FROM,IEN)) Q:'IEN D Q:I=CNT
81 ..S I=I+1 S RESULTS(I)=IEN_"^"_FROM
82 Q
83 ;
84LOGSEC ; [Procedure] Logs secure and restricted record access
85 D NOTICE^DGSEC4(.ANRVRET,DFN,DATA,1)
86 S @RESULTS@(0)=$S(ANRVRET:"1^Logged",1:"-1^Unable to log")
87 Q
88 ;
89PINF(RESULTS,PTDFN) ; [Procedure] Patient Information for verification
90 N Y,GX,GE,NC,Z,X,I
91 D GETS^DIQ(2,+PTDFN,".03;391;1901;.01;.02;.09;.301;.14;","","GX","GE")
92 I $D(GE("DIERR",1)) S RESULTS="0^"_GE("DIERR",1,"TEXT",1) Q
93 S NC=+PTDFN_",",Z="1^"
94 F I=.03,391,1901,.01,.02,.09,.301,.14 D
95 .S X=GX(2,NC,I) S Z=Z_X_"^"
96 S RESULTS=Z
97 Q
98 ;
99RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC Call Tag
100 S RESULTS=$NA(^TMP($J)) K @RESULTS
101 D:$T(@OPTION)]"" @OPTION
102 D:'$D(@RESULTS)
103 .S @RESULTS@(0)="-1^No results returned"
104 D CLEAN^DILF
105 Q
106 ;
107RPCA(RESULTS,OPTION,ENT,PAR,INST,VAL) ; [Procedure] Main RPC entry
108 N ERR,TMP,RET,TXT,IEN,IENS,ROOT
109 S INST=$G(INST,1)
110 S PAR=$G(PAR,"ANRV")
111 S RESULTS=$NA(^TMP($J)) K @RESULTS
112 I PAR'?1"ANRV".E S ^TMP($J,0)="-1^Non VIST Outcomes Parameter" Q
113 D:$T(@OPTION)]"" @OPTION
114 I +$G(ERR) K @RESULTS S @RESULTS@(0)="-1^Error: "_(+ERR)_" "_$P(ERR,U,2)
115 I '$D(^TMP($J)) S @RESULTS@(0)="-1^No data returned"
116 D CLEAN^DILF
117 Q
118 ;
119SELECT ; [Procedure] Select Patient
120 NEW IENS,ANRVDFN,ANRVFLD,ANRVID,ANRVRET,ANRVX
121 I '$D(^DPT(+$G(DFN),0))#2 S @RESULTS@(0)="-1^No such patient" Q
122 S @RESULTS@(0)="1^Required Identifiers & messages"
123 S IENS=DFN_","
124 D FILE^DID(2,,"REQUIRED IDENTIFIERS","ANRVIDS")
125 F ANRVX=0:0 S ANRVX=$O(ANRVIDS("REQUIRED IDENTIFIERS",ANRVX)) Q:'ANRVX D
126 .S ANRVFLD=ANRVIDS("REQUIRED IDENTIFIERS",ANRVX,"FIELD")
127 .S ANRVID="$$PTID^"_$$GET1^DID(2,ANRVFLD,"","LABEL")
128 .S ANRVID=ANRVID_U_$$GET1^DIQ(2,IENS,ANRVFLD)
129 .D:ANRVFLD=.03
130 ..S ANRVID=ANRVID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
131 ..S ANRVID=ANRVID_U_$$DOB^DPTLK1(+IENS)
132 .D:ANRVFLD=.09
133 ..S X=$P(ANRVID,U,3),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
134 ..S $P(ANRVID,U,3)=X,$P(ANRVID,U,4)=$$SSN^DPTLK1(+IENS)
135 .S @RESULTS@($O(@RESULTS@(""),-1)+1)=ANRVID
136 K ANRVRET
137 D GUIBS5A^DPTLK6(.ANRVRET,DFN) D:ANRVRET(1)=1
138 .D ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
139 .S ANRVX=1
140 .F S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX!(+$G(ANRVRET(ANRVX))) D
141 ..D ADD($P(ANRVRET(ANRVX),U,2))
142 .D ADD(" ")
143 .S ANRVX=1
144 .F S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX D:+ANRVRET(ANRVX)
145 ..S ANRVDFN=+$P(ANRVRET(ANRVX),U,2)
146 ..D ADD($$GET1^DIQ(2,ANRVDFN_",",.01)_" "_$$DOB^DPTLK1(ANRVDFN)_" "_$$SSN^DPTLK1(ANRVDFN))
147 .D ADD(" ")
148 .D ADD("Please review carefully before continuing")
149 .D ADD("$$MSGEND")
150 K ANRVRET
151 D PTSEC^DGSEC4(.ANRVRET,DFN) D:ANRVRET(1)'=0
152 .D:ANRVRET(1)=3
153 ..D ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
154 .D:ANRVRET(1)=-1
155 ..D ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
156 .D:ANRVRET(1)=1
157 ..D ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
158 .D:ANRVRET(1)'=-1&(ANRVRET(1)'=3)&(ANRVRET(1)'=1)
159 ..D ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
160 .S ANRVX=1
161 .F S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX D ADD($TR(ANRVRET(ANRVX),"*"," "))
162 .D ADD("$$MSGEND")
163 D GUIMTD^DPTLK6(.ANRVRET,DFN) D:ANRVRET(1)=1
164 .D ADD("$$MSGHDR^1^NOTICE")
165 .F ANRVX=1:0 S ANRVX=$O(ANRVRET(ANRVX)) Q:'ANRVX D ADD(ANRVRET(ANRVX))
166 .D ADD("$$MSGEND")
167 Q
168 ;
169SETLST ; [Procedure] Set single value into a parameter
170 N ANRVINS ; Instance Counter
171 D DELLST(ENT,PAR)
172 S ANRVINS=""
173 F S ANRVINS=$O(VAL(ANRVINS)) Q:ANRVINS="" D
174 .D EN^XPAR(ENT,PAR,ANRVINS,VAL(ANRVINS),.ERR)
175 S:'$G(ERR) @RESULTS@(0)="1^List "_PAR_" rebuilt"
176 Q
177 ;
178SETPAR ; [Procedure] Set single value into a parameter
179 D EN^XPAR(ENT,PAR,INST,VAL,.ERR)
180 S:'$G(ERR) @RESULTS@(0)="1^Parameter updated"
181 Q
182 ;
183SETWP ; [Procedure] Set WP text into a parameter
184 S TXT=INST,TMP=""
185 F S TMP=$O(VAL(TMP)) Q:TMP="" D
186 .S TXT($O(TXT(""),-1)+1,0)=VAL(TMP)
187 D EN^XPAR(ENT,PAR,INST,.TXT,.ERR)
188 S:'$G(ERR) @RESULTS@(0)="1^WP Text Saved"
189 Q
190 ;
191SIGNON ; [Procedure] Return signon information for user.
192 S @RESULTS@(0)=DUZ
193 S @RESULTS@(1)=$$GET1^DIQ(200,DUZ_",",.01) ; Name
194 S @RESULTS@(2)=+$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE")) ;Domain
195 S @RESULTS@(3)=$$KSP^XUPARAM("WHERE") ; Domain Name
196 S @RESULTS@(4)=+$G(DUZ(2)) ; Division IEN
197 S @RESULTS@(5)=$S(+$G(DUZ(2)):$$GET1^DIQ(4,DUZ(2)_",",.01),1:"UNKNOWN")
198 S @RESULTS@(6)=$$GET1^DIQ(200,DUZ_",",8)
199 S @RESULTS@(7)=""
200 S @RESULTS@(8)=$G(DTIME,300)
201 Q
202 ;
Note: See TracBrowser for help on using the repository browser.