source: FOIAVistA/trunk/r/CLINICAL_PROCEDURES-MD/MDRPCOP.m@ 1166

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

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