source: FOIAVistA/tag/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 9.0 KB
Line 
1MDRPCOP ; HOIFO/DP - Object RPCs (TMDPatient) ; [01-09-2003 15:21]
2 ;;1.0;CLINICAL PROCEDURES;**4**;Apr 01, 2004;Build 3
3 ; Integration Agreements:
4 ; IA# 3027 [Supported] Calls to DGSEC4
5 ; IA# 2981 [Subscription] Calls to GUI~GMRCP5
6 ; IA# 2548 [Supported] ACRP Interface Toolkit APIs.
7 ; IA# 2552 [Supported] AIT API to provide outpatient encounter data.
8 ; IA# 10061 [Supported] VADPT calls.
9 ; IA# 3468 [Subscription] Use GMRCCP APIs.
10 ; IA# 3266 [Subscription] Call to DPTLK1
11 ; IA# 10103 [Supported] Call to XLFDT
12 ; IA# 10039 [Supported] Ward Location File (#42) Access.
13 ; IA# 10035 [Supported] DPT references
14 ; IA# 3267 [Subscription] Call to DPTLK1
15 ; IA# 3593 [Supported] Access to routine DPTLK6 utilities for lookup
16 ; IA# 3613 [Private] GETVST^MDRPCOP API call
17 ; IA# 10099 [Supported] GMRADPT call
18 ; IA# 1096 [Controlled Subscription] ^DGPM("ATID1" x-ref loop
19 ;
20ADD(X) ; [Procedure] Add line to @RESULTS@(...
21 S @RESULTS@(+$O(@RESULTS@(""),-1)+1)=X
22 Q
23 ;
24ALLERGY ; [Procedure] Return Allergies
25 D EN1^GMRADPT I '$O(GMRAL(0)) D Q
26 .I $G(GMRAL)="" S @RESULTS@(0)="No Allergy Assessment"
27 .I $G(GMRAL)=0 S @RESULTS@(0)="No Known Allergies"
28 S @RESULTS@(0)="This patient has the following allergy(ies): "
29 F X=0:0 S X=$O(GMRAL(X)) Q:'X D
30 .S @RESULTS@(X)=$P($G(GMRAL(X)),U,2)
31 Q
32 ;
33CHKIN ; [Procedure] Check In Study
34 F X=2:1:5 D
35 .I $P(DATA,U,X)]"" S MDFDA(702,$P(DATA,U,1),$P("^.04^.05^.11^.07",U,X))=$P(DATA,U,X)
36 S MDFDA(702,$P(DATA,U,1),.09)=4 ; Status = Checked-In
37 I $P(DATA,U,1)="+1," D
38 .S MDFDA(702,"+1,",.01)=DFN
39 .S MDFDA(702,"+1,",.02)=$$NOW^XLFDT()
40 .S MDFDA(702,"+1,",.03)=DUZ
41 .D UPDATE^DIE("","MDFDA","MDIEN","MDERR") Q:$D(MDERR)
42 .S MDIENS=MDIEN(1)_",",MDHL7=$$SUB^MDHL7B(MDIEN(1))
43 .I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
44 .I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
45 .D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
46 I $P(DATA,U,1)'="+1," D
47 .D FILE^DIE("","MDFDA","MDERR") Q:$D(MDERR)
48 .S MDIENS=+DATA_","
49 .S MDHL7=$$SUB^MDHL7B(+MDIENS)
50 .I +MDHL7=-1 S MDFDA(702,MDIENS,.09)=2,MDFDA(702,MDIENS,.08)=$P(MDHL7,U,2)
51 .I +MDHL7=1 S MDFDA(702,MDIENS,.09)=5,MDFDA(702,MDIENS,.08)=""
52 .D:$D(MDFDA) FILE^DIE("","MDFDA","MDERR")
53 I '$D(MDERR) S @RESULTS@(0)="1^OK" Q
54 D ERROR^MDRPCU(RESULTS,.MDERR)
55 Q
56 ;
57DISPCON ; [Procedure] Display a consult
58 K ^TMP("GMRC",$J)
59 D GUI^GMRCP5(.RESULTS,DATA)
60 Q
61 ;
62GETCONS ; [Procedure] Get available consults for patient
63 K ^TMP("MDTMP",$J)
64 D CPLIST^GMRCCP(DFN,,$NA(^TMP("MDTMP",$J)))
65 S MDX=0
66 F S MDX=$O(^TMP("MDTMP",$J,MDX)) Q:'MDX D:"saprc"[$P(^(MDX),U,4)
67 .S Y="123;"_$P(^TMP("MDTMP",$J,MDX),U,5)
68 .F X=2,3,4,1,6,5 S Y=Y_U_$P(^TMP("MDTMP",$J,MDX),U,X)
69 .S Y=Y_U_+$O(^MDD(702,"ACON",+$P(^TMP("MDTMP",$J,MDX),U,5)))
70 .;
71 .; Patch MD*1.0*4 - Return number of times checked in at piece 9
72 .;
73 .S (X,Z)=0,MDY=+$P(^TMP("MDTMP",$J,MDX),U,5)
74 .F S X=$O(^MDD(702,"ACON",MDY,X)) Q:'X S Z=Z+1
75 .S $P(Y,U,9)=Z
76 .;
77 .; End Patch MD*1.0*4
78 .;
79 .D ADD(Y)
80 S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
81 K ^TMP("MDTMP",$J)
82 Q
83 ;
84GETHDR ; [Procedure] Get Pt Header
85 S DFNIENS=DFN_","
86 S @RESULTS@(0)=$$GET1^DIQ(2,DFNIENS,.01)_" "_$$GET1^DIQ(2,DFNIENS,.1)_" "_$$GET1^DIQ(2,DFNIENS,.101)
87 S @RESULTS@(1)=$$GET1^DIQ(2,DFNIENS,.09)_" "_$$GET1^DIQ(2,DFNIENS,.02)_" "_$$GET1^DIQ(2,DFNIENS,.03)_" ("_$$GET1^DIQ(2,DFNIENS,.033)_")"
88 Q
89 ;
90GETOBJ ; [Procedure] Get information for TMDPATIENT object
91 D DEM^VADPT,INP^VADPT
92 S @RESULTS@(0)=DFN
93 S @RESULTS@(1)=VADM(1)
94 S @RESULTS@(2)=$P(VADM(2),U,2)
95 S @RESULTS@(3)=$P(VADM(3),U,2)
96 S @RESULTS@(4)=VADM(4)
97 S @RESULTS@(5)=$P(VADM(5),U,2)
98 I VAIN(4)]"" S @RESULTS@(6)="Ward: "_$P(VAIN(4),U,2)_" Rm: "_VAIN(5)
99 E S @RESULTS@(6)=""
100 Q
101 ;
102GETRES ; [Procedure] Get results report
103 F MDX=0:0 S MDX=$O(^MDD(703.1,"ADFN",DFN,MDX)) Q:'MDX D
104 .S MDINST=+$P($G(^MDD(703.1,MDX,0)),U,4)
105 .I $G(DATA) Q:'$D(^MDS(702.01,DATA,.1,"B",MDINST))
106 .S MDY=$O(@RESULTS@(""),-1)+1
107 .S @RESULTS@(MDY)="703.1;"_MDX_U_^MDD(703.1,MDX,0)
108 .S Y=$P(^MDD(703.1,MDX,0),U,3) D D^DIQ
109 .S $P(@RESULTS@(MDY),U,11)=Y
110 .S Y=$P($G(^MDS(702.09,+$P(^MDD(703.1,MDX,0),U,4),0)),U)
111 .S $P(@RESULTS@(MDY),U,12)=Y
112 S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
113 Q
114 ;
115GETTRAN ; [Procedure] Get a patients transactions
116 F MDX=0:0 S MDX=$O(^MDD(702,"B",DFN,+MDX))_"," Q:'MDX D
117 .S Z=$$GET1^DIQ(702,MDX,".04:.02","I")_U_$$GET1^DIQ(702,MDX,.04)_U_$$GET1^DIQ(702,MDX,.02,"I")_U_$$GET1^DIQ(702,MDX,.09)_U_$$GET1^DIQ(702,MDX,.11)_U_$$GET1^DIQ(702,MDX,.991)
118 .S Y=$O(@RESULTS@(""),-1)+1
119 .S @RESULTS@(Y)="702;"_+MDX_U_Z
120 S @RESULTS@(0)=+$O(@RESULTS@(""),-1)
121 Q
122 ;
123GETVST ; [Procedure] Return list of visits
124 N BEG,END,VAERR,VASD,BDT,DTM,EDT,LOC,NOW,MDQUERY,MDLST,STI,STS,TODAY,I,J,K,XI,XE,X
125 S NOW=$$NOW^XLFDT(),TODAY=$P(NOW,".",1)
126 S BEG=$$X2FM("T-200"),END=$$X2FM("T")+0.2359
127 S MDLST="",MDSTOP=""
128 I END>NOW D ; get future encounters, past cancels/no-shows from VADPT
129 .S VASD("F")=BEG
130 .S VASD("T")=END
131 .S VASD("W")="123456789"
132 .D SDA^VADPT
133 .S I=0 F S I=$O(^UTILITY("VASD",$J,I)) Q:'I D
134 ..S XI=^UTILITY("VASD",$J,I,"I"),XE=^("E")
135 ..S DTM=$P(XI,U),IEN=$P(XI,U,2),STI=$P(XI,U,3)
136 ..S LOC=$P(XE,U,2),STS=$P(XE,U,3)
137 ..I DTM<TODAY,(STI=""!(STI["I")!(STI="NT")) Q ; no prior kept appts
138 ..S MDLST(DTM,"A",1)="A;"_DTM_";"_IEN_U_DTM_U_LOC_U_STS
139 .K ^UTILITY("VASD",$J)
140 I BEG'>NOW D ;past encounters from ACRP Toolkit - set in CALLBACK
141 .S BDT=BEG
142 .S EDT=$S(END<NOW:END,1:NOW)
143 .D OPEN^SDQ(.MDQUERY)
144 .I '$$ERRCHK^SDQUT() D INDEX^SDQ(.MDQUERY,"PATIENT/DATE","SET")
145 .I '$$ERRCHK^SDQUT() D PAT^SDQ(.MDQUERY,DFN,"SET")
146 .I '$$ERRCHK^SDQUT() D DATE^SDQ(.MDQUERY,BDT,EDT,"SET")
147 .I '$$ERRCHK^SDQUT() D
148 ..D SCANCB^SDQ(.MDQUERY,"D CALLBACK^ORWCV(Y,Y0,$NA(MDLST),.MDSTOP)","SET")
149 .I '$$ERRCHK^SDQUT() D ACTIVE^SDQ(.MDQUERY,"TRUE","SET")
150 .I '$$ERRCHK^SDQUT() D SCAN^SDQ(.MDQUERY,"FORWARD")
151 .D CLOSE^SDQ(.MDQUERY)
152 N TIM,MOV,MDX0,Y,MTIM,XTYP,XLOC,XLOCI,HLOC,EARLY,DONE ; admits
153 S EARLY=BEG,DONE=0
154 S TIM="" F S TIM=$O(^DGPM("ATID1",DFN,TIM)) Q:TIM'>0 D Q:DONE
155 .S MOV=0 F S MOV=$O(^DGPM("ATID1",DFN,TIM,MOV)) Q:MOV'>0 D Q:DONE
156 ..D GETS^DIQ(405,+MOV_",","*","IE","MDX0") S MTIM=$G(MDX0(405,MOV_",",".01","I"))
157 ..S XTYP=$G(MDX0(405,+MOV_",",".04","E"))
158 ..S XLOC=$G(MDX0(405,+MOV_",",".06","E"))
159 ..S XLOCI=+$G(MDX0(405,+MOV_",",".06","I")),HLOC=+$G(^DIC(42,+XLOCI,44))
160 ..S MDLST(MTIM,"I",1)="I;"_MTIM_";"_HLOC_U_MTIM_U_"Inpatient Stay"_U_XLOC_U_XTYP
161 ..S DONE=1 ; Not sure if I should include all stays <DRP@Hines>
162 S I=0 F S I=$O(MDLST(I)) Q:'I D
163 .S J="" F S J=$O(MDLST(I,J)) Q:J="" D
164 ..S K=0 F S K=$O(MDLST(I,J,K)) Q:'K D
165 ...S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDLST(I,J,K)
166 S @RESULTS@(0)=+$O(@RESULTS@(""),-1)_U_($$GET1^DIQ(2,DFN_",",.1)]"")
167 Q
168 ;
169LOGSEC ; [Procedure] Log Security
170 D NOTICE^DGSEC4(.RESULTS,DFN,DATA,1)
171 S @RESULTS@(0)=$S(RESULTS:"1^Logged",1:"-1^Unable to log")
172 Q
173 ;
174RPC(RESULTS,OPTION,DFN,DATA) ; [Procedure] Main RPC call tag
175 NEW DFNIENS,GMRAL,GMVALG,GN,IENS,MDDFN,MDERR,MDFDA,MDFLD,MDHL7,MDID,MDIDS,MDIEN,MDIENS,MDRET,MDX,MDY,VA,VADM,VAERR,VAIN,Z
176 S RESULTS=$NA(^TMP($J)) K @RESULTS
177 D:$T(@OPTION)]"" @OPTION
178 D:'$D(@RESULTS) BADRPC^MDRPCU("MD TMDPATIENT","MDRPCOP",OPTION)
179 D CLEAN^DILF
180 Q
181 ;
182SELECT ; [Procedure] Select patient
183 I '$D(^DPT(+$G(DFN),0))#2 S @RESULTS@(0)="-1^No such patient" Q
184 S @RESULTS@(0)="1^Required Identifiers & messages"
185 S IENS=DFN_","
186 D FILE^DID(2,,"REQUIRED IDENTIFIERS","MDIDS")
187 F MDX=0:0 S MDX=$O(MDIDS("REQUIRED IDENTIFIERS",MDX)) Q:'MDX D
188 .S MDFLD=MDIDS("REQUIRED IDENTIFIERS",MDX,"FIELD")
189 .S MDID="$$PTID^"_$$GET1^DID(2,MDFLD,"","LABEL")
190 .S MDID=MDID_U_$$GET1^DIQ(2,IENS,MDFLD)
191 .D:MDFLD=.03
192 ..S MDID=MDID_" ("_$$GET1^DIQ(2,IENS,.033)_")"
193 ..S MDID=MDID_U_$$DOB^DPTLK1(+IENS)
194 .D:MDFLD=.09
195 ..S X=$P(MDID,U,3),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
196 ..S $P(MDID,U,3)=X,$P(MDID,U,4)=$$SSN^DPTLK1(+IENS)
197 .S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
198 S MDID="$$PTID^"_$$GET1^DID(2,.1,"","LABEL")
199 S MDID=MDID_U_$$GET1^DIQ(2,IENS,.1)
200 S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
201 S MDID="$$PTID^"_$$GET1^DID(2,.101,"","LABEL")
202 S MDID=MDID_U_$$GET1^DIQ(2,IENS,.101)
203 S @RESULTS@($O(@RESULTS@(""),-1)+1)=MDID
204 K MDRET
205 D GUIBS5A^DPTLK6(.MDRET,DFN) D:MDRET(1)=1
206 .D ADD("$$MSGHDR^2^SAME LAST NAME AND LAST 4")
207 .S MDX=1
208 .F S MDX=$O(MDRET(MDX)) Q:'MDX!(+$G(MDRET(MDX))) D
209 ..D ADD($P(MDRET(MDX),U,2))
210 .D ADD(" ")
211 .S MDX=1
212 .F S MDX=$O(MDRET(MDX)) Q:'MDX D:+MDRET(MDX)
213 ..S MDDFN=+$P(MDRET(MDX),U,2)
214 ..D ADD($$GET1^DIQ(2,MDDFN_",",.01)_" "_$$DOB^DPTLK1(MDDFN)_" "_$$SSN^DPTLK1(MDDFN))
215 .D ADD(" ")
216 .D ADD("Please review carefully before continuing")
217 .D ADD("$$MSGEND")
218 K MDRET
219 D PTSEC^DGSEC4(.MDRET,DFN) D:MDRET(1)'=0
220 .D:MDRET(1)=3
221 ..D ADD("$$MSGHDR^0^CAN'T ACCESS YOUR OWN RECORD!!")
222 .D:MDRET(1)=-1
223 ..D ADD("$$MSGHDR^0^INCOMPLETE INFORMATION - CAN'T PROCEED")
224 .D:MDRET(1)=1
225 ..D ADD("$$MSGHDR^1^SENSITIVE RECORD ACCESS")
226 .D:MDRET(1)'=-1&(MDRET(1)'=3)&(MDRET(1)'=1)
227 ..D ADD("$$MSGHDR^3^SENSITIVE RECORD ACCESS")
228 .S MDX=1
229 .F S MDX=$O(MDRET(MDX)) Q:'MDX D ADD($TR(MDRET(MDX),"*"," "))
230 .D ADD("$$MSGEND")
231 D GUIMTD^DPTLK6(.MDRET,DFN) D:MDRET(1)=1
232 .D ADD("$$MSGHDR^1^NOTICE")
233 .F MDX=1:0 S MDX=$O(MDRET(MDX)) Q:'MDX D ADD(MDRET(MDX))
234 .D ADD("$$MSGEND")
235 Q
236 ;
237X2FM(X) ; [Function] return FM date given relative date
238 N %DT S %DT="TS" D ^%DT
239 Q Y
240 ;
Note: See TracBrowser for help on using the repository browser.