RABWIBB2.m

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

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