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