source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABWUTL.m@ 1608

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

initial load of WorldVistAEHR

File size: 905 bytes
RevLine 
[613]1RABWUTL ;HISC/SM - Billing Aware utilities ;3/24/04
2 ;;5.0;Radiology/Nuclear Medicine;**41**;Mar 16,1998
3 Q
4ODX(RA) ;ordering diagnosis
5 ;RA = ien file 75.1
6 ;RAX(n) = ien80^SC^AO^IR^EC^MST^HNC^CV where pieces 2+ has 1=Y
7 ;N RAX,RA1,I,J,RABA,RA751,X
8 S RA751=$S($D(RAORD0):RAORD0,1:^RAO(75.1,RA,0))
9 D GETDX
10 D WRTDX
11 Q
12GETDX ; get DX and Clin. Indicators from file 75.1
13 Q:'$D(^RAO(75.1,RA,"BA")) S RAX(1)=^("BA")
14 S I=0,RA1=1
15 F S I=$O(^RAO(75.1,RA,"BAS",I)) Q:'I D
16 . S RA1=RA1+1
17 . S RAX(RA1)=^RAO(75.1,RA,"BAS",I,0)
18 .Q
19 Q
20WRTDX ; write DX and Clin. Inds.
21 Q:'$O(RAX(0))
22 W !,"Ordering Diagnoses:"
23 S I=0
24 F S I=$O(RAX(I)) Q:'I D
25 . W !?2,$$GET1^DIQ(80,+RAX(I),.01),?10,$$GET1^DIQ(80,+RAX(I),3)
26 . S X=$P(RAX(I),U,2,8)
27 . Q:X'["1"
28 . W !,?10,"Clinical Indicator(s): "
29 . F J=1:1:7 I $P(X,U,J) W $S(J=1:"SC",J=2:"AO",J=3:"IR",J=4:"EC",J=5:"MST",J=6:"HNC",1:"CV") I J<7,$P(X,U,J+1) W ","
30 . Q
31 Q
Note: See TracBrowser for help on using the repository browser.