| 1 | RABWIBB2 ;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
|
|---|
| 7 | GA(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
|
|---|
| 53 | STOR751(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
|
|---|
