source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC1.m@ 645

Last change on this file since 645 was 645, checked in by Sam Habiel, 14 years ago

Initial Import of BMX.net code
File size: 7.7 KB
Line 
1BMXRPC1 ; IHS/OIT/HMW - UTIL: REMOTE PROCEDURE CALLS ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; UTILITY: CODE FOR REMOTE PROCEDURE CALLS.
5 ;; RETURNS PATIENT DATA, HEALTH SUMMARY, FACE SHEET.
6 ;
7 ;
8 ;----------
9PDATA(BMXDATA,BMXDFN) ;EP
10 ;---> Return Patient Data in 5 ^-delimited pieces:
11 ;---> 1 - DOB in format: OCT 01,1994.
12 ;---> 2 - Age in format: 35 Months.
13 ;---> 3 - Text of Patient's sex.
14 ;---> 4 - HRCN in the format XX-XX-XX.
15 ;---> 5 - Text of ACTIVE/INACTIVE Status.
16 ;---> Parameters:
17 ; 1 - BMXDATA (ret) String of patient data||error.
18 ; 2 - BMXDFN (req) DFN of patient.
19 ;
20 ;---> Delimiter to pass error with result to GUI.
21 N BMX31,BMXERR S BMX31=$C(31)_$C(31)
22 S BMXDATA="",BMXERR=""
23 ;
24 ;---> If DFN not supplied, set Error Code and quit.
25 I '$G(BMXDFN) D Q
26 .;D ERRCD^BMXUTL2(201,.BMXERR) S BMXDATA=BMX31_BMXERR
27 ;
28 ;---> DOB.
29 S BMXDATA=$$TXDT1^BMXUTL5($$DOB^BMXUTL1(BMXDFN))
30 ;
31 ;---> Age.
32 S BMXDATA=BMXDATA_U_$$AGEF^BMXUTL1(BMXDFN)
33 ;
34 ;---> Text of sex.
35 S BMXDATA=BMXDATA_U_$$SEXW^BMXUTL1(BMXDFN)
36 ;
37 ;---> HRCN, format XX-XX-XX.
38 S BMXDATA=BMXDATA_U_$$HRCN^BMXUTL1(BMXDFN)
39 ;
40 ;---> Active/Inactive Status.
41 ;S BMXDATA=BMXDATA_U_$$ACTIVE^BMXUTL1(BMXDFN)
42 ;
43 S BMXDATA=BMXDATA_BMX31
44 ;
45 Q
46 ;
47 ;
48 ;----------
49HS(BMXGBL,BMXDFN) ;EP
50 ;---> Return patient's Health Summary in global array, ^BMXTEMP($J,"HS".
51 ;---> Lines delimited by "^".
52 ;---> Called by RPC: BMX IMMSERVE PT PROFILE
53 ;---> Parameters:
54 ; 1 - BMXGBL (ret) Name of result global containing patient's
55 ; Health Summary, passed to Broker.
56 ; 2 - BMXDFN (req) DFN of patient.
57 ;
58 ;---> Delimiter to pass error with result to GUI.
59 N BMX30,BMX31,BMXERR,X
60 S BMX30=$C(30),BMX31=$C(31)_$C(31)
61 S BMXGBL="^BMXTEMP("_$J_",""HS"")",BMXERR=""
62 K ^BMXTEMP($J,"HS")
63 ;
64 ;---> If DFN not supplied, set Error Code and quit.
65 I '$G(BMXDFN) D Q
66 .;D ERRCD^BMXUTL2(201,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
67 ;
68 ;---> If patient does not exist, set Error Code and quit.
69 I '$D(^AUPNPAT(BMXDFN,0)) D Q
70 .;D ERRCD^BMXUTL2(203,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
71 ;
72 N APCHSPAT,APCHSTYP
73 S APCHSPAT=BMXDFN,APCHSTYP=7
74 ;---> Doesn't work from Device 56.
75 ;D GUIR^XBLM("EN^APCHS","^TMP(""BMXHS"",$J,")
76 ;
77 ;---> Generate a host file name.
78 N BMXFN S BMXFN="XB"_$J
79 ;
80 D
81 .;---> Important to preserve IO variables for when $I returns to 56.
82 .N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY
83 .;
84 .;---> Open host file to receive legacy code display.
85 .;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"W")
86 .;
87 .;---> Call to legacy code for Health Summary display.
88 .D EN^APCHS
89 .;---> Write End of File (EOF) marker.
90 .W $C(9)
91 .;
92 .;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
93 .;D ^%ZISC
94 .;---> Buffer won't write out to file until the device is closed
95 .;---> or the buffer is flushed by some other command.
96 .;---> At this point, host file exists but has 0 bytes.
97 .;C 51
98 .;---> Now host file contains legacy code display data.
99 .;
100 .;---> For some reason %ZISH cannot open the host file a second time.
101 .;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"R")
102 .;O 51:($$HFSPATH^BMXUTL1_BMXFN:"R")
103 .;U 51
104 .;
105 .;---> Read in the host file.
106 .D
107 ..;---> Stop reading Host File if line contains EOF $C(9).
108 ..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXHS",$J,I)=Y
109 .;
110 .;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
111 .;D ^%ZISC
112 .;C 51
113 ;
114 ;---> At this point $I=1. The job has "forgotten" its $I, even
115 ;---> though %SS shows 56 as the current device. $I=1 causes a
116 ;---> <NOPEN> at CAPI+10^XWBBRK2. A simple USE 56 command
117 ;---> appears to "remind" the job its $I is 56, and it works.
118 ;---> Possibly this is something %ZISC ordinarily does.
119 ;U 56
120 ;
121 ;---> Copy Health Summary to global array for passing back to GUI.
122 N I,N,U,X S U="^"
123 S N=0
124 F I=1:1 S N=$O(^TMP("BMXHS",$J,N)) Q:'N D
125 .;---> Set null lines (line breaks) equal to one space, so that
126 .;---> Windows reader will quit only at the final "null" line.
127 .S X=^TMP("BMXHS",$J,N) S:X="" X=" "
128 .S ^BMXTEMP($J,"HS",I)=X_BMX30
129 ;
130 ;---> If no Health Summary produced, report it as an error.
131 D:'$O(^BMXTEMP($J,"HS",0))
132 .;D ERRCD^BMXUTL2(407,.BMXERR) S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
133 ;
134 ;---> Tack on Error Delimiter and any error.
135 S ^BMXTEMP($J,"HS",I)=BMX31_BMXERR
136 ;
137 ;---> This works; host file gets deleted.
138 ;S Y=$$DEL^%ZISH($$HFSPATH^BMXUTL1,BMXFN)
139 K ^TMP("BMXHS",$J)
140 Q
141 ;
142 ;
143 ;----------
144FACE(BMXGBL,BMXDFN) ;EP
145 ;---> Return patient's Face Sheet in global array, ^BMXTEMP($J,"FACE".
146 ;---> Lines delimited by "^".
147 ;---> Called by RPC: BMX IMMSERVE PT PROFILE
148 ;---> Parameters:
149 ; 1 - BMXGBL (ret) Name of result global containing patient's
150 ; Face Sheet, passed to Broker.
151 ; 2 - BMXDFN (req) DFN of patient.
152 ;
153 ;---> Delimiter to pass error with result to GUI.
154 N BMX30,BMX31,BMXERR,X
155 S BMX30=$C(30),BMX31=$C(31)_$C(31)
156 S BMXGBL="^BMXTEMP("_$J_",""FACE"")",BMXERR=""
157 K ^BMXTEMP($J,"FACE")
158 ;
159 ;---> If DFN not supplied, set Error Code and quit.
160 I '$G(BMXDFN) D Q
161 .;D ERRCD^BMXUTL2(201,.BMXERR) S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
162 ;
163 ;---> If patient does not exist, set Error Code and quit.
164 I '$D(^AUPNPAT(BMXDFN,0)) D Q
165 .;D ERRCD^BMXUTL2(203,.BMXERR) S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
166 ;
167 N DFN S DFN=BMXDFN
168 ;---> Doesn't work from Device 56.
169 ;---> Generate a host file name.
170 N BMXFN S BMXFN="XB"_$J
171 ;
172 D
173 .;---> Important to preserve IO variables for when $I returns to 56.
174 .N IO,IOBS,IOF,IOHG,IOM,ION,IOPAR,IOS,IOSL,IOST,IOT,IOUPAR,IOXY
175 .;
176 .;---> Open host file to receive legacy code display.
177 .;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"W")
178 .;
179 .;---> Call to legacy code for Face Sheet display.
180 .U 51
181 .;D ^BMXFACE
182 .;---> Write End of File (EOF) marker.
183 .W $C(9)
184 .;
185 .;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
186 .;D ^%ZISC
187 .;---> Buffer won't write out to file until the device is closed
188 .;---> or the buffer is flushed by some other command.
189 .;---> At this point, host file exists but has 0 bytes.
190 .;C 51
191 .;---> Now host file contains legacy code display data.
192 .;
193 .;---> For some reason %ZISH cannot open the host file a second time.
194 .;S Y=$$OPEN^%ZISH($$HFSPATH^BMXUTL1,BMXFN,"R")
195 .;O 51:($$HFSPATH^BMXUTL1_BMXFN:"R")
196 .U 51
197 .;
198 .;---> Read in the host file.
199 .D
200 ..;---> Need some way to mark the end of legacy code output.
201 ..;---> Stop reading Host File if line contains EOF $C(9).
202 ..;---> (I added $C(9) above, after ^BMXFACE completed.)
203 ..;N I,Y F I=1:1 R Y Q:Y[$C(9) S ^TMP("BMXFACE",$J,I)=Y
204 .;
205 .;---> %ZISC doesn't close Device 51 when called from TCPIP socket?
206 .;D ^%ZISC
207 .;C 51
208 ;
209 ;---> At this point $I=1. The job has "forgotten" its $I, even
210 ;---> though %SS shows 56 as the current device. $I=1 causes a
211 ;---> <NOPEN> at CAPI+10^XWBBRK2. A simple USE 56 command
212 ;---> appears to "remind" the job its $I is 56, and it works.
213 ;---> Possibly this is something %ZISC ordinarily does.
214 U 56
215 ;
216 ;---> Copy Face Sheet to global array for passing back to GUI.
217 N I,N,U,X S U="^"
218 S N=0
219 F I=1:1 S N=$O(^TMP("BMXFACE",$J,N)) Q:'N D
220 .;---> Set null lines (line breaks) equal to one space, so that
221 .;---> Windows reader will quit only at the final "null" line.
222 .S X=^TMP("BMXFACE",$J,N) S:X="" X=" "
223 .;---> Remove Carriage Return (13)_Formfeed (12) characters.
224 .I X[$C(13)_$C(12) S X=$P(X,$C(13)_$C(12),2)
225 .;
226 .S ^BMXTEMP($J,"FACE",I)=X_BMX30
227 ;
228 ;---> If no Health Summary produced, report it as an error.
229 D:'$O(^BMXTEMP($J,"FACE",0))
230 .;D ERRCD^BMXUTL2(408,.BMXERR) S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
231 ;
232 ;---> Tack on Error Delimiter and any error.
233 S ^BMXTEMP($J,"FACE",I)=BMX31_BMXERR
234 ;
235 ;---> This works; host file gets deleted.
236 ;S Y=$$DEL^%ZISH($$HFSPATH^BMXUTL1,BMXFN)
237 K ^TMP("BMXFACE",$J)
238 Q
Note: See TracBrowser for help on using the repository browser.