source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABWPCE.m@ 846

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1RABWPCE ;HISC/MM - Billing Awareness Project: PCE API ; 3/23/04 10:17am
2 ;;5.0;Radiology/Nuclear Medicine;**41**; Mar 16, 1998
3 Q
4 ;
5DX(RAO) ; Create ^TMP("RAPXAPI",$J,"DX/PL" for PCE API: Ordering ICD Dx.
6 ; Called from LON+n^RAPCE.
7 ; ^RAO(75.1,RAO,"BAx",0) = ICD Diagnosis^SC^AO^IR^EC^MST^HNC
8 ; Set an Order" node for Billing Replacement
9 S ^TMP("RAPXAPI",$J,"PROCEDURE",1,"ORD REFERENCE")=$P(^RAO(75.1,RAO,0),U,7)
10 I '$D(^RAO(75.1,RAO,"BA")) Q
11 N RA1,RA2,RA3,RACNT,RADXTYP,RAIND
12 ;
13 ; Create Temp. Array of the Clinical Indicators.
14 S RAIND(1)="SC",RAIND(2)="AO",RAIND(3)="IR"
15 S RAIND(4)="EC",RAIND(5)="MST",RAIND(6)="HNC",RAIND(7)="CV"
16 ;
17 S RACNT=0
18 S RA2=^RAO(75.1,RAO,"BA") D DXPL ; Primary Ordering ICD Dx.
19 S RA1=0
20 F S RA1=$O(^RAO(75.1,RAO,"BAS",RA1)) Q:+RA1<1 S RA2=^(RA1,0) D DXPL
21 Q
22 ;
23DXPL ; Create "DX/PL" Node.
24 S RACNT=RACNT+1
25 S RADXTYP=$S(RACNT=1:"P",1:"S")
26 S ^TMP("RAPXAPI",$J,"DX/PL",RACNT,"DIAGNOSIS")=$P(RA2,U)
27 S ^TMP("RAPXAPI",$J,"DX/PL",RACNT,"PRIMARY")=RADXTYP
28 ;F RA3=2:1:8 I $P(RA2,U,RA3)'="" D
29 F RA3=2:1:8 D
30 .S ^TMP("RAPXAPI",$J,"DX/PL",RACNT,"PL "_RAIND(RA3-1))=$P(RA2,U,RA3)
31 Q
32 ;
33PROCDX(X) ; Called from PROC^RAPCE.
34 ; Add Ordering ICD Dx to Procedure for Billing Purposes.
35 N I
36 F I=1:1:8 Q:'$D(^TMP("RAPXAPI",$J,"DX/PL",I,"DIAGNOSIS")) D
37 .I I=1 S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"DIAGNOSIS")=^("DIAGNOSIS") Q
38 .S ^TMP("RAPXAPI",$J,"PROCEDURE",X,"DIAGNOSIS "_I)=^("DIAGNOSIS")
39 Q
Note: See TracBrowser for help on using the repository browser.