source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXADOX.m@ 1605

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

Mumps Routines 4 BMX4
File size: 14.1 KB
Line 
1BMXADOX ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
2 ;;4.1000;BMX;;Apr 17, 2011;Build 13
3 ; EXMAPLES OF RPMS SCHEMAE GENERATION
4 ;
5 ;
6DISP(OUT) ;EP - TEMP DISPLAY
7 N I,X
8 S I=0 W !
9 F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X
10 Q
11 ;
12SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
13 N IEN
14 S IEN=$O(^BMXADO("B",NAME,0))
15 Q IEN
16 ;
17NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT
18 N X,LAST,MAX,NUM
19 S NUM=0,MAX=""
20 F S NUM=$O(^AUPNPROB("AA",DFN,LOC,NUM)) Q:NUM="" S X=$E(NUM,2,99) I +X>MAX S MAX=+X
21 I 'MAX Q 1
22 S X=X+1 S X=X\1
23 Q X
24 ;
25DEMOG ; VIEW DEMOGRAPHICS
26 N OUT,%,DFN,MAX,SIEN
27 S DFN=1,MAX=1000
28 S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
29 D SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX))
30 D DISP(OUT) R %:$G(DTIME,60)
31 K ^TMP("BMX ADO",$J)
32 Q
33 ;
34MEDICARE ; UPDATE MEDICARE DATES/INFO
35 N OUT,%,DAS,PIEN,JIEN,DFN,MAX
36 S DFN=1,MAX=1000
37 S DAS=DFN_","
38 S PIEN=$$SCHEMA("UPDATE MEDICARE DATES")
39 S JIEN=$$SCHEMA("UPDATE MEDICARE INFO")
40 D SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT"))
41 D DISP(OUT) R %:$G(DTIME,60)
42 K ^TMP("BMX ADO",$J)
43 Q
44 ;
45MEDICAID ; VIEW MEDICAID DATES/INFO
46 N OUT,%,DAS,PIEN,JIEN,DFN,DA
47 S DFN=3
48 S DA(1)=$$MCDIEN^BMXADOV2(DFN) I 'DA(1) Q
49 S DAS=DA(1)_","
50 S PIEN=$$SCHEMA("UPDATE MEDICAID DATES")
51 S JIEN=$$SCHEMA("UPDATE MEDICAID INFO")
52 D SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT"))
53 D DISP(OUT) R %:$G(DTIME,60)
54 K ^TMP("BMX ADO",$J)
55 Q
56 ;
57PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO
58 N OUT,%,DAS,SIEN,DFN
59 S DFN=1
60 S DAS=DFN_","
61 S SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO")
62 D SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~")
63 D DISP(OUT) R %:$G(DTIME,60)
64 K ^TMP("BMX ADO",$J)
65 Q
66 ;
67VISIT ; VIEW VISITS
68 N OUT,%,SIEN,DFN
69 S DFN=1
70 S SIEN=$$SCHEMA("VISITS")
71 D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|R")
72 D DISP(OUT) R %:$G(DTIME,60)
73 K ^TMP("BMX ADO",$J)
74 Q
75 ;
76DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS
77 N OUT,%,SIEN,DFN
78 S DFN=1
79 S SIEN=$$SCHEMA("VISITS")
80 D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~1|4/19/04@1PM|I|4585|A~")
81 D DISP(OUT) R %:$G(DTIME,60)
82 K ^TMP("BMX ADO",$J)
83 Q
84 ;
85ADDVIS ; ADD A NEW VISIT
86 N OUT,%,SIEN,DFN,NODE
87 S DFN=3
88 S SIEN=$$SCHEMA("VISITS")
89 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
90 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
91 S ^TMP("BMX ADO",$J,NODE)="^JUN 03, 2004@09:32^I^`3^`4585^A^`1"_$C(30)
92 D DISP(OUT) R %:$G(DTIME,60)
93 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
94 K ^TMP("BMX ADO",$J)
95 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
96 Q
97 ;
98POV ; DISPLAY POVS
99 N OUT,%,SIEN,DFN
100 S DFN=1
101 S SIEN=$$SCHEMA("VIEW POVS")
102 D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~100~~~~1|C")
103 D DISP(OUT) R %:$G(DTIME,60)
104 K ^TMP("BMX ADO",$J)
105 Q
106 ;
107FLDS ; GET FILEMAN FIELDS
108 N OUT,%,SIEN,DFN
109 S SIEN=$$SCHEMA("FIELDS")
110 D SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~3.7~")
111 D DISP(OUT) R %:$G(DTIME,60)
112 K ^TMP("BMX ADO",$J)
113 Q
114 ;
115FINFO ; GET FILEMAN FILEINFO
116 N OUT,%,SIEN,DFN
117 S SIEN=$$SCHEMA("FILEMAN FILEINFO")
118 D SS^BMXADO(.OUT,SIEN,"","~~~~~FNIT~BMXADOS1~3.7~")
119 D DISP(OUT) R %:$G(DTIME,60)
120 K ^TMP("BMX ADO",$J)
121 Q
122 ;
123ADDPOV ; ADD A POV TO AN EXISITING VISIT
124 N OUT,%,SIEN,DFN,NODE
125 S DFN=1
126 S SIEN=$$SCHEMA("UPDATE POVS")
127 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
128 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
129 S ^TMP("BMX ADO",$J,NODE)="^`8718^`1^`71164^DM II ON NEW MEDS^2^P"_$C(30)
130 D DISP(OUT) R %:$G(DTIME,60)
131 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
132 K ^TMP("BMX ADO",$J)
133 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
134 Q
135 ;
136EDITPOV ; ADD A POV TO AN EXISITING VISIT
137 N OUT,%,SIEN,DFN,NODE
138 S DFN=1
139 S SIEN=$$SCHEMA("UPDATE POVS")
140 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
141 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
142 S ^TMP("BMX ADO",$J,NODE)="100123^`8718^`1^`71164^DM II ON SPECIAL MEDS^2^P"_$C(30)
143 D DISP(OUT) R %:$G(DTIME,60)
144 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
145 K ^TMP("BMX ADO",$J)
146 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
147 Q
148 ;
149PROB ; DISPLAY PROBLEMS
150 N OUT,%,SIEN,DFN
151 S DFN=1
152 S SIEN=$$SCHEMA("VIEW PROBLEMS")
153 D SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~")
154 D DISP(OUT) R %:$G(DTIME,60)
155 K ^TMP("BMX ADO",$J)
156 Q
157 ;
158ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST
159 N OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN
160 S ICD=2477
161 S TEXT="HYPERTENSION ON SPECIAL MEDS"
162 S DFN=1,LOC=DUZ(2),AIR="A"
163 S SIEN=$$SCHEMA("UPDATE PROBLEMS")
164 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
165 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
166 S ^TMP("BMX ADO",$J,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_$C(30)
167 D DISP(OUT) R %:$G(DTIME,60)
168 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
169 K ^TMP("BMX ADO",$J)
170 S IEN=+$P(OUT(1),"|",2) I '$D(^AUPNPROB(IEN,0)) Q
171 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
172 K OUT
173 S NUM=$$NEXTNUM(DFN,LOC) I 'NUM Q ; PROBLEM NUMBER & STATUS MUST BE ADDED SEPARATELY
174 S SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER")
175 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
176 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
177 S ^TMP("BMX ADO",$J,NODE)=IEN_U_NUM_U_"A"_$C(30)
178 D DISP(OUT) R %:$G(DTIME,60)
179 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
180 K ^TMP("BMX ADO",$J)
181 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
182 Q
183 ;
184MEAS ; DISPLAY MEASUREMENTS
185 N OUT,%,SIEN,DFN
186 S DFN=1
187 S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
188 D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1985~6/4/1986~10~~~~"_DFN_"|WT|C")
189 D DISP(OUT) R %:$G(DTIME,60)
190 K ^TMP("BMX ADO",$J)
191 Q
192 ;
193ADDMEAS ; UPDATE V MEASUREMENT FILE
194 N OUT,%,SIEN,DFN,NODE
195 S DFN=1
196 S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
197 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
198 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
199 S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`71164^177.5^`6"_$C(30)
200 D DISP(OUT) R %:$G(DTIME,60)
201 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
202 K ^TMP("BMX ADO",$J)
203 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
204 Q
205 ;
206MEDS ; DISPLAY MEDS
207 N OUT,%,SIEN,DFN
208 S DFN=3
209 S SIEN=$$SCHEMA("VIEW MEDS")
210 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1989~12/31/1990~10~~~~"_DFN_"|C")
211 D DISP(OUT) R %:$G(DTIME,60)
212 K ^TMP("BMX ADO",$J)
213 Q
214 ;
215ADDMEDS ; UPDATE V MED FILE
216 N OUT,%,SIEN,DFN,NODE
217 S DFN=3
218 S SIEN=$$SCHEMA("UPDATE MEDS")
219 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
220 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
221 S ^TMP("BMX ADO",$J,NODE)="^`305^`"_DFN_"^`71164^T1T QID^40"_$C(30)
222 D DISP(OUT) R %:$G(DTIME,60)
223 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
224 K ^TMP("BMX ADO",$J)
225 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
226 Q
227 ;
228LAB ; DISPLAY LAB TEST RESULTS
229 N OUT,%,SIEN,DFN
230 S DFN=1
231 S SIEN=$$SCHEMA("VIEW LABS")
232 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1987~10~~~~"_DFN_"|175|C")
233 D DISP(OUT) R %:$G(DTIME,60)
234 K ^TMP("BMX ADO",$J)
235 Q
236 ;
237ADDLAB ; UPDATE V LAB
238 N OUT,%,SIEN,DFN,NODE
239 S DFN=1
240 S SIEN=$$SCHEMA("UPDATE LABS")
241 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
242 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
243 S ^TMP("BMX ADO",$J,NODE)="^`175^`"_DFN_"^`71164^216"_$C(30)
244 D DISP(OUT) R %:$G(DTIME,60)
245 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
246 K ^TMP("BMX ADO",$J)
247 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
248 Q
249 ;
250EXAMS ; DISPLAY EXAMS
251 N OUT,%,SIEN,DFN
252 S DFN=1
253 S SIEN=$$SCHEMA("VIEW EXAMS")
254 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1990~10~~~~"_DFN_"|6|C")
255 D DISP(OUT) R %:$G(DTIME,60)
256 K ^TMP("BMX ADO",$J)
257 Q
258 ;
259ADDEXAMS ; UPDATE V EXAM
260 S DFN=1
261 S SIEN=$$SCHEMA("UPDATE EXAMS")
262 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
263 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
264 S ^TMP("BMX ADO",$J,NODE)="^`6^`"_DFN_"^`71164^NORMAL"_$C(30)
265 D DISP(OUT) R %:$G(DTIME,60)
266 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
267 K ^TMP("BMX ADO",$J)
268 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
269 Q
270 ;
271IMM ; DISPLAY IMMUNIZATIONS
272 N OUT,%,SIEN,DFN
273 S DFN=2
274 S SIEN=$$SCHEMA("VIEW IMM")
275 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1986~12/31/1988~10~~~~"_DFN_"|12|C")
276 D DISP(OUT) R %:$G(DTIME,60)
277 K ^TMP("BMX ADO",$J)
278 Q
279 ;
280ADDIMM ; UPDATE V IMMUNIZATION FILE
281 S DFN=2
282 S SIEN=$$SCHEMA("UPDATE IMM")
283 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
284 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
285 S ^TMP("BMX ADO",$J,NODE)="^`12^`"_DFN_"^`71164^2"_$C(30)
286 D DISP(OUT) R %:$G(DTIME,60)
287 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
288 K ^TMP("BMX ADO",$J)
289 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
290 Q
291 ;
292PROV ; DISPLAY PROVIDERS FOR A VISIT
293 N OUT,%,SIEN,VIEN
294 S VIEN=11
295 S SIEN=$$SCHEMA("VIEW PROV")
296 D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
297 D DISP(OUT) R %:$G(DTIME,60)
298 K ^TMP("BMX ADO",$J)
299 Q
300 ;
301ADDPROV ; UPDATE V PROVIDER FILE
302 N OUT,%,SIEN,NODE,PIEN,DFN
303 S PIEN=5,DFN=1
304 I $P(^DD(9000010.06,.01,0),U,3)["DIC(6" S PIEN=$P(^VA(200,PIEN,0),U,16) ; CONVERT FILE 200 TO FILE 16 IF NECESS.
305 S SIEN=$$SCHEMA("UPDATE PROV")
306 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
307 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
308 S ^TMP("BMX ADO",$J,NODE)="^`"_PIEN_"^`"_DFN_"^`71164^P"_$C(30)
309 D DISP(OUT) R %:$G(DTIME,60)
310 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
311 K ^TMP("BMX ADO",$J)
312 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
313 Q
314 ;
315PROC ; DISPLAY PROCEDURES
316 N OUT,%,SIEN,DFN
317 S DFN=4
318 S SIEN=$$SCHEMA("VIEW PROCEDURES")
319 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1985~12/31/1985~10~~~~"_DFN_"|C")
320 D DISP(OUT) R %:$G(DTIME,60)
321 K ^TMP("BMX ADO",$J)
322 Q
323 ;
324ADDPROC ; UPDATE V PROCEDURES FILE
325 N OUT,%,SIEN,DFN,NODE
326 S DFN=1
327 S SIEN=$$SCHEMA("UPDATE PROCEDURES")
328 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
329 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
330 S ^TMP("BMX ADO",$J,NODE)="^`2198^`"_DFN_"^`71164^`8718"_$C(30)
331 D DISP(OUT) R %:$G(DTIME,60)
332 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
333 K ^TMP("BMX ADO",$J)
334 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
335 Q
336 ;
337CPT ; DISPLAY CPT CODES
338 N OUT,%,SIEN,DFN
339 S VIEN=71164
340 S SIEN=$$SCHEMA("VIEW CPT")
341 D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
342 D DISP(OUT) R %:$G(DTIME,60)
343 K ^TMP("BMX ADO",$J)
344 Q
345 ;
346ADDCPT ; UPDATE V CPT FILE
347 N OUT,%,SIEN,DFN,NODE
348 S DFN=1
349 S SIEN=$$SCHEMA("UPDATE CPT")
350 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
351 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
352 S ^TMP("BMX ADO",$J,NODE)="^`10000^`"_DFN_"^`71164^WOUND CARE"_$C(30)
353 D DISP(OUT) R %:$G(DTIME,60)
354 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
355 K ^TMP("BMX ADO",$J)
356 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
357 Q
358 ;
359PH ; DISPLAY PERSONAL HISTORY
360 N OUT,%,SIEN,DFN
361 S DFN=632
362 S SIEN=$$SCHEMA("VIEW PERSONAL HISTORY")
363 D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
364 D DISP(OUT) R %:$G(DTIME,60)
365 K ^TMP("BMX ADO",$J)
366 Q
367 ;
368ADDPH ; UPDATE PERSONAL HX
369 N OUT,%,SIEN,DFN,NODE,ICD,TEXT
370 S ICD=2477
371 S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
372 S DFN=632
373 S SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY")
374 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
375 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
376 S ^TMP("BMX ADO",$J,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$C(30)
377 D DISP(OUT) R %:$G(DTIME,60)
378 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
379 K ^TMP("BMX ADO",$J)
380 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
381 Q
382 ;
383FH ; DISPLAY FAMILY HX
384 N OUT,%,SIEN,DFN
385 S DFN=631
386 S SIEN=$$SCHEMA("VIEW FAMILY HISTORY")
387 D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
388 D DISP(OUT) R %:$G(DTIME,60)
389 K ^TMP("BMX ADO",$J)
390 Q
391 ;
392ADDFH ; UPDATE FAMILY HISTORY
393 N OUT,%,SIEN,DFN,NODE,ICD,TEXT
394 S ICD=2477
395 S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
396 S DFN=631
397 S SIEN=$$SCHEMA("UPDATE FAMILY HISTORY")
398 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
399 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
400 S ^TMP("BMX ADO",$J,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$C(30)
401 D DISP(OUT) R %:$G(DTIME,60)
402 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
403 K ^TMP("BMX ADO",$J)
404 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
405 Q
406 ;
407HF ; DISPLAY HEALTH FACTORS
408 N OUT,%,SIEN,DFN
409 S DFN=1
410 S SIEN=$$SCHEMA("VIEW HEALTH FACTORS")
411 D SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~")
412 D DISP(OUT) R %:$G(DTIME,60)
413 K ^TMP("BMX ADO",$J)
414 Q
415 ;
416ADDHF ; UPDATE HEALTH FACTORS FILE
417 N OUT,%,SIEN,DFN,NODE
418 S DFN=1
419 S SIEN=$$SCHEMA("UPDATE HEALTH FACTORS")
420 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
421 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
422 S ^TMP("BMX ADO",$J,NODE)="^`3^`"_DFN_U_DT_$C(30)
423 D DISP(OUT) R %:$G(DTIME,60)
424 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
425 K ^TMP("BMX ADO",$J)
426 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
427 Q
428 ;
429REPRO ; DISPLAY REPRODUCTIVE FACTORS
430 N OUT,%,SIEN,DFN
431 S DFN=5
432 S SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS")
433 D SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~")
434 D DISP(OUT) R %:$G(DTIME,60)
435 K ^TMP("BMX ADO",$J)
436 Q
437 ;
438ADDREPRO ; UPDATE REPRODUCTIVE FACTORS
439 ; THE .O1 FIELD IS DINUMED
440 ; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT
441 N OUT,%,SIEN,DFN,NODE
442 S DFN=5
443 ; I $D(^AUPNREP(DFN)) G ERF
444 S SIEN=$$SCHEMA("ADD REPRODUCTIVE FACTORS")
445 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
446 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
447 S ^TMP("BMX ADO",$J,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$C(30)
448 D DISP(OUT) R %:$G(DTIME,60)
449 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
450 K ^TMP("BMX ADO",$J)
451 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
452 Q
453 ;
454 ; ---------------------------------- GRIDS ---------------------------------------------
455 ;
456GRID ; POPULATE THE INTRO GRID
457 N OUT,%,SIEN,NODE,NEXT
458 S NEXT="70470;0"
459 S SIEN=$$SCHEMA("VEN MOJO DE INTRO")
460 D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
461 D DISP(OUT) R %:$G(DTIME,60)
462 K ^TMP("BMX ADO",$J)
463 Q
464 ;
465MGRID ; POPULATE THE MEASUREMENT GRID
466 N OUT,%,SIEN,NODE,NEXT,START,STOP
467 S NEXT="70470;2"
468 S SIEN=$$SCHEMA("VEN MOJO DE MEASUREMENT")
469 ; D SS^BMXADO(.OUT,SIEN,"","~~~~~GRIDIT~VENPCCTG~"_NEXT) ; GET SCHEMA
470 D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
471 D DISP(OUT) R %:$G(DTIME,60)
472 ; K ^TMP("BMX ADO",$J)
473 Q
474 ;
475PRVGRID ; POPULATE THE PROVIDER GRID
476 N OUT,%,SIEN,NODE,NEXT
477 S NEXT="70470;4"
478 S SIEN=$$SCHEMA("VEN MOJO DE PROVIDER")
479 D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
480 D DISP(OUT) R %:$G(DTIME,60)
481 K ^TMP("BMX ADO",$J)
482 Q
483 ;
484CLGRID ; POPULATE THE CLINIC GRID
485 N OUT,%,SIEN,NODE,NEXT
486 S NEXT="70470;8"
487 S SIEN=$$SCHEMA("VEN MOJO DE CLINIC")
488 D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
489 D DISP(OUT) R %:$G(DTIME,60)
490 K ^TMP("BMX ADO",$J)
491 Q
492 ;
493DXGRID ; POPULATE THE DX GRID
494 N OUT,%,SIEN,NODE,NEXT
495 S NEXT="70470;1"
496 S SIEN=$$SCHEMA("VEN MOJO DE DX DXHX")
497 D SS^BMXADO(.OUT,SIEN,"","ASEG~"_NEXT_"~"_NEXT) ; GET SCHEMA
498 D DISP(OUT) R %:$G(DTIME,60)
499 K ^TMP("BMX ADO",$J)
500 Q
501 ;
Note: See TracBrowser for help on using the repository browser.