source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RABWIBB2.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1RABWIBB2 ;HOIFO/MDM - Radiology Billing Awareness ;12/20/04 12:55am
2 ;;5.0;Radiology/Nuclear Medicine;**57**;Mar 16, 1998
3 ; $$GETACCT^IBBAPI uses DBIA #4664
4 ; Calls referencing PFSS Account Referance (field 90 file #75.1)) uses DBIA #4741
5 ;
6 Q
7GA(RAOIFN) ; Get Account Reference
8 ;
9 N RAMISDAT,RAPRO,RAITYP,RADAT,RADX,S1,S2,P1,IBBDFN,IBBPV1,IBBPV2
10 N IBBDG1,IBBPR1,IBBZCL,RABADAT,RABAFLD,RAORD0
11 ; Called from FB^RABWIBB
12 ; Define remaining (Required) IBB Variables and Arrays
13 ;
14 ; Radiology Orders Data
15 S RAORD0=$G(^RAO(75.1,RAOIFN,0))
16 S IBBDFN=$P(RAORD0,U,1) ; PATIENT NAME Pointer to patient file #2
17 S IBBPV1(2)=$P(RAORD0,U,4) ; PATIENT STATUS I(npatient) O(utpatient)
18 S IBBPV1(3)=$P(RAORD0,U,20)
19 S IBBPV1(3)=$P($G(^RA(79.1,IBBPV1(3),0)),U,1) ; IMAGING LOCATION
20 S IBBPV1(7)=$P(RAORD0,U,14) ; REQUESTING PHYSICIAN
21 S IBBPV1(44)=$P(RAORD0,U,21),IBBPV2(8)=IBBPV1(44) ; DATE DESIRED
22 S IBBDG1(1,6)="A" ; DIAGNOSIS TYPE
23 ;
24 ; CPT Code
25 S RAPRO=$P(RAORD0,U,2) ; Procedure Pointer
26 S RAMISDAT=^RAMIS(71,+RAPRO,0) ; Procedure Data
27 S IBBPR1(3)=$P(RAMISDAT,U,9) ; Isolate CPT Code
28 ; If there is no CPT Code then get the procedure name instead.
29 I IBBPR1(3)="" S IBBPR1(4)=$P(RAMISDAT,U,1) K IBBPR1(3)
30 ;
31 ; ABBREVIATION FOR TYPE OF IMAGING
32 S RAITYP=$P(RAORD0,U,3) ; Image Type File Pointer
33 S RADAT=^RA(79.2,+RAITYP,0) ; Image Type File Data
34 S IBBPR1(6)=$P(RADAT,U,3) ; Image Type Abbreviation
35 ;
36 ; CLINICAL INDICATORS RELATED TO PRIMARY DX
37 ; Initialize gathering process variables.
38 S S1="",RADX(92)=3,RADX(93)=1,RADX(94)=2,RADX(95)=4,RADX(96)=5
39 S RADX(97)=6,RADX(99)=7
40 S RABADAT=$G(^RAO(75.1,+RAOIFN,"BA"))
41 S IBBDG1(1,3)=$P(RABADAT,U,1) ; PRIMARY DIAGNOSIS CODE
42 S IBBZCL=""
43 F P1=92:1:97,99 S RABAFLD=$P($P(^DD(75.1,P1,0),U,4),";",2) I $P(RABADAT,U,RABAFLD)]"" D
44 . S S1=S1+1
45 . ; IBBZCL(n,2)=clin. Indic. type, IBBZCL(n,3)={0,1,null}
46 . S IBBZCL(S1,2)=RADX(P1)
47 . S IBBZCL(S1,3)=$P(RABADAT,U,RABAFLD)
48 . Q
49 ;
50 ; Get Account Reference
51 S RACCOUNT=$$GETACCT^IBBAPI(IBBDFN,IBBARFN,IBBEVENT,IBBAPLR,.IBBPV1,.IBBPV2,.IBBPR1,.IBBDG1,.IBBZCL,"",+RAOIFN)
52 Q
53STOR751(RAOIFN) ; Store acct ref no. in file 75.1, field 90, for this order
54 ;
55 N RAFDA
56 S RAFDA(75.1,+RAOIFN_",",90)=RACCOUNT
57 D FILE^DIE("K","RAFDA")
58 Q
Note: See TracBrowser for help on using the repository browser.