[613] | 1 | RABWUTL ;HISC/SM - Billing Aware utilities ;3/24/04
|
---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**41**;Mar 16,1998
|
---|
| 3 | Q
|
---|
| 4 | ODX(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
|
---|
| 12 | GETDX ; 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
|
---|
| 20 | WRTDX ; 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
|
---|