source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXADOXX.m@ 1416

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

Mumps Routines 4 BMX4
File size: 12.4 KB
Line 
1BMXADOXX ; 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 ;
6ADDPAT ;
7 N OUT,%,SIEN,DFN,NODE
8 ;S DFN=9285
9 S SIEN=$$SCHEMA("UPDATE VA PATIENT")
10 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
11 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
12 S ^TMP("BMX ADO",$J,NODE)="^KANGAROO,KAP^M^1-1-83^151515555"_$C(30)
13 D DISP(OUT) R %:$G(DTIME,60)
14 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
15 K ^TMP("BMX ADO",$J)
16 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
17 ;
18 Q
19 ;
20DISP(OUT) ; TEMP DISPLAY
21 N I,X
22 S I=0 W !
23 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
24 Q
25 ;
26SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
27 N IEN
28 S IEN=$O(^BMXADO("B",NAME,0))
29 Q IEN
30 ;
31NEXTNUM(DFN,LOC) ; RETURN THE NEXT PROBLEM NUMBER FOR A PATIENT
32 N X,LAST,MAX,NUM
33 S NUM=0,MAX=""
34 F S NUM=$O(^AUPNPROB("AA",DFN,LOC,NUM)) Q:NUM="" S X=$E(NUM,2,99) I +X>MAX S MAX=+X
35 I 'MAX Q 1
36 S X=X+1 S X=X\1
37 Q X
38 ;
39DEMOG ; VIEW DEMOGRAPHICS
40 N OUT,%,DFN,MAX,SIEN
41 S DFN=1373,MAX=1000
42 S SIEN=$$SCHEMA("UPDATE PATIENT DEMOGRAPHICS")
43 D SS^BMXADO(.OUT,SIEN,"",("~"_DFN_"~"_DFN_"~"_MAX))
44 D DISP(OUT) R %:$G(DTIME,60)
45 K ^TMP("BMX ADO",$J)
46 Q
47 ;
48MEDICARE ; UPDATE MEDICARE DATES/INFO
49 N OUT,%,DAS,PIEN,JIEN,DFN,MAX
50 S DFN=1,MAX=1000
51 S DAS=DFN_","
52 S PIEN=$$SCHEMA("UPDATE MEDICARE DATES")
53 S JIEN=$$SCHEMA("UPDATE MEDICARE INFO")
54 D SS^BMXADO(.OUT,PIEN,DAS,("~"_DFN_"~"_DFN_"~"_MAX_"~~"_"MEDICARE~BMXADOV2~~"_JIEN_",PARENT"))
55 D DISP(OUT) R %:$G(DTIME,60)
56 K ^TMP("BMX ADO",$J)
57 Q
58 ;
59MEDICAID ; VIEW MEDICAID DATES/INFO
60 N OUT,%,DAS,PIEN,JIEN,DFN,DA
61 S DFN=322
62 S DA(1)=$$MCDIEN^BMXADOV2(DFN) I 'DA(1) Q
63 S DAS=DA(1)_","
64 S PIEN=$$SCHEMA("UPDATE MEDICAID DATES")
65 S JIEN=$$SCHEMA("UPDATE MEDICAID INFO")
66 D SS^BMXADO(.OUT,PIEN,DAS,("~~~~~MEDICAID~BMXADOV2~~"_JIEN_",PARENT"))
67 D DISP(OUT) R %:$G(DTIME,60)
68 K ^TMP("BMX ADO",$J)
69 Q
70 ;
71PVTINS ; VIEW PRIVATE INSURANCE DATES/INFO
72 N OUT,%,DAS,SIEN,DFN
73 S DFN=96
74 S DAS=DFN_","
75 S SIEN=$$SCHEMA("UPDATE PVT INSURANCE INFO")
76 D SS^BMXADO(.OUT,SIEN,DAS,"~~~~~PVTINS~BMXADOV2~~")
77 D DISP(OUT) R %:$G(DTIME,60)
78 K ^TMP("BMX ADO",$J)
79 Q
80 ;
81VISIT ; VIEW VISITS
82 N OUT,%,SIEN,DFN
83 S DFN=9285
84 S SIEN=$$SCHEMA("VISITS")
85 D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1968~6/4/2004~100~~~~9285|C")
86 D DISP(OUT) R %:$G(DTIME,60)
87 K ^TMP("BMX ADO",$J)
88 Q
89 ;
90DUPVIS ; DISPLAY POSSIBLE DUPLICATE VISITS
91 N OUT,%,SIEN,DFN
92 S DFN=9285
93 S SIEN=$$SCHEMA("VISITS")
94 D SS^BMXADO(.OUT,SIEN,"","~~~~~DUPV~BMXADOV2~9285|5/24/04@1PM|I|516|~")
95 D DISP(OUT) R %:$G(DTIME,60)
96 K ^TMP("BMX ADO",$J)
97 Q
98 ;
99ADDVIS ; ADD A NEW VISIT
100 N OUT,%,SIEN,DFN,NODE
101 S DFN=9285
102 S SIEN=$$SCHEMA("VISITS")
103 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
104 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
105 S ^TMP("BMX ADO",$J,NODE)="^JUN 03, 2004@01:32^I^`9285^`516^A^`2"_$C(30)
106 D DISP(OUT) R %:$G(DTIME,60)
107 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
108 K ^TMP("BMX ADO",$J)
109 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
110 Q
111 ;
112POV ; DISPLAY POVS
113 N OUT,%,SIEN,DFN
114 S DFN=9285
115 S SIEN=$$SCHEMA("VIEW POVS")
116 D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~100~~~~9285|C")
117 D DISP(OUT) R %:$G(DTIME,60)
118 K ^TMP("BMX ADO",$J)
119 Q
120 ;
121ADDPOV ; ADD A POV TO AN EXISITING VISIT
122 N OUT,%,SIEN,DFN,NODE
123 S DFN=9285
124 S SIEN=$$SCHEMA("UPDATE POVS")
125 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
126 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
127 S ^TMP("BMX ADO",$J,NODE)="^`8718^`9285^`8337^DM II ON EXPMTL MEDS^2^P"_$C(30)
128 D DISP(OUT) R %:$G(DTIME,60)
129 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
130 K ^TMP("BMX ADO",$J)
131 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
132 Q
133 ;
134EDITPOV ; ADD A POV TO AN EXISITING VISIT
135 N OUT,%,SIEN,DFN,NODE
136 S DFN=1
137 S SIEN=$$SCHEMA("UPDATE POVS")
138 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
139 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
140 S ^TMP("BMX ADO",$J,NODE)="2815^`8718^`9285^`8337^DM II ON SPECIAL MEDS^2^P"_$C(30)
141 D DISP(OUT) R %:$G(DTIME,60)
142 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
143 K ^TMP("BMX ADO",$J)
144 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
145 Q
146 ;
147PROB ; DISPLAY PROBLEMS
148 N OUT,%,SIEN,DFN
149 S DFN=1373
150 S SIEN=$$SCHEMA("VIEW PROBLEMS")
151 D SS^BMXADO(.OUT,SIEN,"","AA~"_DFN_"~"_DFN_"~~~~~")
152 D DISP(OUT) R %:$G(DTIME,60)
153 K ^TMP("BMX ADO",$J)
154 Q
155 ;
156ADDPROB ; ADD A PROBLEM TO THE PROBLEM LIST
157 N OUT,%,SIEN,DFN,NODE,NUM,LOC,ICD,TEXT,AIR,IEN
158 S ICD=2477
159 S TEXT="HYPERTENSION ON SPECIAL MEDS"
160 S DFN=1373,LOC=DUZ(2)
161 S SIEN=$$SCHEMA("UPDATE PROBLEMS")
162 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
163 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
164 S ^TMP("BMX ADO",$J,NODE)=U_"`"_ICD_U_"`"_DFN_U_DT_U_U_TEXT_U_"`"_LOC_U_DT_U_$C(30)
165 D DISP(OUT) R %:$G(DTIME,60)
166 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
167 K ^TMP("BMX ADO",$J)
168 S IEN=+$P(OUT(1),"|",2) I '$D(^AUPNPROB(IEN,0)) Q
169 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
170 K OUT
171 S NUM=$$NEXTNUM(DFN,LOC) I 'NUM Q
172 S SIEN=$$SCHEMA("UPDATE PROBLEM NUMBER")
173 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
174 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
175 S ^TMP("BMX ADO",$J,NODE)=IEN_U_NUM_U_"A"_$C(30)
176 D DISP(OUT) R %:$G(DTIME,60)
177 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
178 K ^TMP("BMX ADO",$J)
179 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
180 Q
181 ;
182MEAS ; DISPLAY MEASUREMENTS
183 N OUT,%,SIEN,DFN
184 S DFN=2
185 S SIEN=$$SCHEMA("VIEW MEASUREMENTS")
186 D SS^BMXADO(.OUT,SIEN,"","AA~3/21/1965~6/4/2004~10~~~~"_DFN_"|WT|C")
187 D DISP(OUT) R %:$G(DTIME,60)
188 K ^TMP("BMX ADO",$J)
189 Q
190 ;
191ADDMEAS ; UPDATE V MEASUREMENT FILE
192 N OUT,%,SIEN,DFN,NODE
193 S DFN=2
194 S SIEN=$$SCHEMA("UPDATE MEASUREMENTS")
195 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
196 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
197 S ^TMP("BMX ADO",$J,NODE)="^`2^`"_DFN_"^`7806^172.75"_$C(30)
198 D DISP(OUT) R %:$G(DTIME,60)
199 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
200 K ^TMP("BMX ADO",$J)
201 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
202 Q
203 ;
204MEDS ; DISPLAY MEDS
205 N OUT,%,SIEN,DFN
206 S DFN=152
207 S SIEN=$$SCHEMA("VIEW MEDS")
208 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1969~12/31/2004~10~~~~"_DFN_"|C")
209 D DISP(OUT) R %:$G(DTIME,60)
210 K ^TMP("BMX ADO",$J)
211 Q
212 ;
213ADDMEDS ; UPDATE V MED FILE
214 N OUT,%,SIEN,DFN,NODE
215 S DFN=2
216 S SIEN=$$SCHEMA("UPDATE MEDS")
217 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
218 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
219 S ^TMP("BMX ADO",$J,NODE)="^`305^`"_DFN_"^`7806^T1T QID^40"_$C(30)
220 D DISP(OUT) R %:$G(DTIME,60)
221 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
222 K ^TMP("BMX ADO",$J)
223 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
224 Q
225 ;
226LAB ; DISPLAY LAB TEST RESULTS
227 N OUT,%,SIEN,DFN
228 S DFN=280
229 S SIEN=$$SCHEMA("VIEW LABS")
230 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~10~~~~"_DFN_"|175|C")
231 D DISP(OUT) R %:$G(DTIME,60)
232 K ^TMP("BMX ADO",$J)
233 Q
234 ;
235ADDLAB ; UPDATE V LAB
236 N OUT,%,SIEN,DFN,NODE
237 S DFN=2
238 S SIEN=$$SCHEMA("UPDATE LABS")
239 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
240 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
241 S ^TMP("BMX ADO",$J,NODE)="^`175^`"_DFN_"^`7806^216"_$C(30)
242 D DISP(OUT) R %:$G(DTIME,60)
243 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
244 K ^TMP("BMX ADO",$J)
245 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
246 Q
247 ;
248EXAMS ; DISPLAY EXAMS
249 N OUT,%,SIEN,DFN
250 S DFN=1373
251 S SIEN=$$SCHEMA("VIEW EXAMS")
252 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|6|C")
253 D DISP(OUT) R %:$G(DTIME,60)
254 K ^TMP("BMX ADO",$J)
255 Q
256 ;
257ADDEXAMS ; UPDATE V EXAM
258 S DFN=2
259 S SIEN=$$SCHEMA("UPDATE EXAMS")
260 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
261 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
262 S ^TMP("BMX ADO",$J,NODE)="^`6^`"_DFN_"^`7806^NORMAL"_$C(30)
263 D DISP(OUT) R %:$G(DTIME,60)
264 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
265 K ^TMP("BMX ADO",$J)
266 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
267 Q
268 ;
269IMM ; DISPLAY IMMUNIZATIONS
270 N OUT,%,SIEN,DFN
271 S DFN=54
272 S SIEN=$$SCHEMA("VIEW IMM")
273 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1966~12/31/2003~10~~~~"_DFN_"|101|C")
274 D DISP(OUT) R %:$G(DTIME,60)
275 K ^TMP("BMX ADO",$J)
276 Q
277 ;
278PROV ; DISPLAY PROVIDERS FOR A VISIT
279 N OUT,%,SIEN,VIEN
280 S VIEN=4703
281 S SIEN=$$SCHEMA("VIEW PROV")
282 D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
283 D DISP(OUT) R %:$G(DTIME,60)
284 K ^TMP("BMX ADO",$J)
285 Q
286 ;
287ADDPROV ; UPDATE V PROVIDER FILE
288 N OUT,%,SIEN,NODE,PIEN,DFN
289 S PIEN=DUZ,DFN=2
290 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.
291 S SIEN=$$SCHEMA("UPDATE PROV")
292 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
293 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
294 S ^TMP("BMX ADO",$J,NODE)="^`"_PIEN_"^`"_DFN_"^`7806^P"_$C(30)
295 D DISP(OUT) R %:$G(DTIME,60)
296 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
297 K ^TMP("BMX ADO",$J)
298 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
299 Q
300 ;
301PROC ; DISPLAY PROCEDURES
302 N OUT,%,SIEN,DFN
303 S DFN=235
304 S SIEN=$$SCHEMA("VIEW PROCEDURES")
305 D SS^BMXADO(.OUT,SIEN,"","AA~1/1/1965~12/31/2003~10~~~~"_DFN_"|C")
306 D DISP(OUT) R %:$G(DTIME,60)
307 K ^TMP("BMX ADO",$J)
308 Q
309 ;
310ADDPROC ; UPDATE V PROCEDURES FILE
311 N OUT,%,SIEN,DFN,NODE
312 S DFN=2
313 S SIEN=$$SCHEMA("UPDATE PROCEDURES")
314 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
315 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
316 S ^TMP("BMX ADO",$J,NODE)="^`2198^`"_DFN_"^`7806^`8718"_$C(30)
317 D DISP(OUT) R %:$G(DTIME,60)
318 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
319 K ^TMP("BMX ADO",$J)
320 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
321 Q
322 ;
323CPT ; DISPLAY CPT CODES
324 N OUT,%,SIEN,DFN
325 S VIEN=8082
326 S SIEN=$$SCHEMA("VIEW CPT")
327 D SS^BMXADO(.OUT,SIEN,"","AD~"_VIEN_"~"_VIEN_"~10~~~~")
328 D DISP(OUT) R %:$G(DTIME,60)
329 K ^TMP("BMX ADO",$J)
330 Q
331 ;
332ADDCPT ; UPDATE V CPT FILE
333 N OUT,%,SIEN,DFN,NODE
334 S DFN=2
335 S SIEN=$$SCHEMA("UPDATE CPT")
336 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
337 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
338 S ^TMP("BMX ADO",$J,NODE)="^`10000^`"_DFN_"^`7806"_$C(30)
339 D DISP(OUT) R %:$G(DTIME,60)
340 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
341 K ^TMP("BMX ADO",$J)
342 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
343 Q
344 ;
345PH ; DISPLAY PERSONAL HISTORY
346 N OUT,%,SIEN,DFN
347 S DFN=1373
348 S SIEN=$$SCHEMA("VIEW PERSONAL HISTORY")
349 D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
350 D DISP(OUT) R %:$G(DTIME,60)
351 K ^TMP("BMX ADO",$J)
352 Q
353 ;
354ADDPH ; UPDATE PERSONAL HX
355 N OUT,%,SIEN,DFN,NODE,ICD,TEXT
356 S ICD=2477
357 S TEXT="PERSONAL HISTORY OF SERIOUS PROBLEMS"
358 S DFN=2
359 S SIEN=$$SCHEMA("UPDATE PERSONAL HISTORY")
360 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
361 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
362 S ^TMP("BMX ADO",$J,NODE)="^`11353^`"_DFN_"^2851219^"_TEXT_"^2810303"_$C(30)
363 D DISP(OUT) R %:$G(DTIME,60)
364 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
365 K ^TMP("BMX ADO",$J)
366 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
367 Q
368 ;
369FH ; DISPLAY FAMILY HX
370 N OUT,%,SIEN,DFN
371 S DFN=631
372 S SIEN=$$SCHEMA("VIEW FAMILY HISTORY")
373 D SS^BMXADO(.OUT,SIEN,"","AC~"_DFN_"~"_DFN_"~~~~~")
374 D DISP(OUT) R %:$G(DTIME,60)
375 K ^TMP("BMX ADO",$J)
376 Q
377 ;
378ADDFH ; UPDATE FAMILY HISTORY
379 N OUT,%,SIEN,DFN,NODE,ICD,TEXT
380 S ICD=2477
381 S TEXT="FAMILY HISTORY OF SERIOUS PROBLEMS"
382 S DFN=2
383 S SIEN=$$SCHEMA("UPDATE FAMILY HISTORY")
384 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
385 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
386 S ^TMP("BMX ADO",$J,NODE)="^`7571^`"_DFN_"^2851219^"_TEXT_$C(30)
387 D DISP(OUT) R %:$G(DTIME,60)
388 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
389 K ^TMP("BMX ADO",$J)
390 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
391 Q
392 ;
393HF ; DISPLAY HEALTH FACTORS
394 N OUT,%,SIEN,DFN
395 S DFN=2390
396 S SIEN=$$SCHEMA("VIEW HEALTH FACTORS")
397 D SS^BMXADO(.OUT,SIEN,"","AC"_"~"_DFN_"~"_DFN_"~~~~~")
398 D DISP(OUT) R %:$G(DTIME,60)
399 K ^TMP("BMX ADO",$J)
400 Q
401 ;
402ADDHF ; UPDATE HEALTH FACTORS FILE
403 N OUT,%,SIEN,DFN,NODE
404 S DFN=2
405 S SIEN=$$SCHEMA("UPDATE HEALTH FACTORS")
406 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
407 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
408 S ^TMP("BMX ADO",$J,NODE)="^`3^`"_DFN_U_DT_$C(30)
409 D DISP(OUT) R %:$G(DTIME,60)
410 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
411 K ^TMP("BMX ADO",$J)
412 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
413 Q
414 ;
415REPRO ; DISPLAY REPRODUCTIVE FACTORS
416 N OUT,%,SIEN,DFN
417 S DFN=1373
418 S SIEN=$$SCHEMA("VIEW REPRODUCTIVE FACTORS")
419 D SS^BMXADO(.OUT,SIEN,"","B"_"~"_DFN_"~"_DFN_"~~~~~")
420 D DISP(OUT) R %:$G(DTIME,60)
421 K ^TMP("BMX ADO",$J)
422 Q
423 ;
424ADDREPRO ; UPDATE REPRODUCTIVE FACTORS
425 ; THE .O1 FIELD IS DINUMED
426 ; THEREFORE, THE FILER WILL AUTOMATICALLY SWITCH TO MOD MODE IF A RECORD ALREADY EXISTS FOR THIS PATIENT
427 N OUT,%,SIEN,DFN,NODE
428 S DFN=2
429 ; I $D(^AUPNREP(DFN)) G ERF
430 S SIEN=$$SCHEMA("UPDATE REPRODUCTIVE FACTORS")
431 D SS^BMXADO(.OUT,SIEN,"","") ; GET SCHEMA
432 S NODE=$O(^TMP("BMX ADO",$J,999999),-1)+1
433 S ^TMP("BMX ADO",$J,NODE)="^`"_DFN_"^G5P4LC3SA1TA0^"_DT_"^2^3040101^"_DT_$C(30)
434 D DISP(OUT) R %:$G(DTIME,60)
435 D BAFM^BMXADOF1(.OUT,$NA(^TMP("BMX ADO",$J)))
436 K ^TMP("BMX ADO",$J)
437 W !!,OUT S %=0 F S %=$O(OUT(%)) Q:'% W !,OUT(%)
438 Q
439 ;
Note: See TracBrowser for help on using the repository browser.