FBAAIARC.m

FBAAIARC ;ALB/ESG - FEE IPAC Vendor Payment Report (Detail) Compile continued ;2/4/2014

 ;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 Q

 ;

COMPILE ; entry point for the compile to build the scratch global

 ; may be background task if job queued

 ;

 K ^TMP("FBAAIARB",$J)

 I '$D(ZTQUEUED) W !!,"Compiling IPAC Vendor Payment Report.  Please wait ... "

 I $D(FBIATYPE("OUT"))!$D(FBIATYPE("ANC")) D COMPOUT   ; outpatient/ancillary

 I $D(FBIATYPE("INP")) D COMPIN                        ; inpatient

 I $D(FBIATYPE("RX")) D COMPRX                         ; prescription

 ;

 D PRINT^FBAAIARD                 ; print report

 D ^%ZISC                         ; close the device

 K ^TMP("FBAAIARB",$J)            ; kill scratch

 I $D(ZTQUEUED) S ZTREQ="@"       ; purge the task

COMPILX ;

 Q

 ;

COMPOUT ; compile Outpatient and Ancillary data

 ;

 N DATA,FBDODINV,FBDT,FBJ,FBK,FBL,FBM,FBPTSSN,FBVENAME,FBVENID

 N FBY0,FBY2,FBY3,FBYREJ,FBZADJ,FBZDOS,FBZIENS,FBZPTNM,FBZTYPE,FEEPROG

 S FBDT=$O(^FBAAC("AK",FBIABEG),-1)

 F  S FBDT=$O(^FBAAC("AK",FBDT)) Q:'FBDT!(FBDT>FBIAEND)  D

 . S FBJ=0 F  S FBJ=$O(^FBAAC("AK",FBDT,FBJ)) Q:'FBJ  D    ; FBJ=patient DFN

 .. S FBZPTNM=$P($G(^DPT(FBJ,0)),U,1) Q:FBZPTNM=""         ; patient name for scratch global

 .. S FBPTSSN=$P($G(^DPT(FBJ,0)),U,9)                      ; full patient SSN

 .. S FBK=0 F  S FBK=$O(^FBAAC("AK",FBDT,FBJ,FBK)) Q:'FBK  D       ; FBK=vendor ien

 ... I '$D(FBIAVEN(FBK)) Q                  ; make sure vendor is among the selected vendors for the report

 ... S FBVENAME=$P($G(^FBAAV(FBK,0)),U,1)   ; vendor name

 ... I FBVENAME="" S FBVENAME="~unk"

 ... S FBVENID=$P($G(^FBAAV(FBK,0)),U,2)    ; vendor external ID

 ... S FBL=0 F  S FBL=$O(^FBAAC("AK",FBDT,FBJ,FBK,FBL)) Q:'FBL  D

 .... S FBZDOS=+$P($G(^FBAAC(FBJ,1,FBK,1,FBL,0)),U,1) Q:'FBZDOS     ; initial treatment date (DOS) for scratch global

 .... S FBM=0 F  S FBM=$O(^FBAAC("AK",FBDT,FBJ,FBK,FBL,FBM)) Q:'FBM  D

 ..... S FBY0=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0))

 ..... S FEEPROG=+$P(FBY0,U,9)   ; Fee Program ptr

 ..... I FEEPROG=2,'$D(FBIATYPE("OUT")) Q               ; Outpatient not a chosen type for report

 ..... I FEEPROG'=2,'$D(FBIATYPE("ANC")) Q              ; Civil Hosp Ancillary not a chosen type for report

 ..... S FBZTYPE=$S(FEEPROG=2:"1-OUTPAT",1:"4-ANCIL")   ; type subscript for scratch global

 ..... S FBY2=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,2))

 ..... S FBY3=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,3))

 ..... S FBYREJ=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"FBREJ"))

 ..... S FBDODINV=$P(FBY3,U,7) I FBDODINV="" Q        ; DoD invoice# must be present

 ..... I FBIAIGNORE,$P(FBY2,U,4) Q                    ; cancellation date exists

 ..... I FBIAIGNORE,$P(FBY0,U,21)'="" Q               ; line has been voided

 ..... I FBIAIGNORE,$P(FBYREJ,U,1)'="" Q              ; line has been rejected

 ..... I FBIAADJ,$P(FBY0,U,3)'<$P(FBY0,U,2) Q         ; skip paid in full line items

 ..... ;

 ..... S FBZIENS=FBM_","_FBL_","_FBK_","_FBJ_","      ; iens

 ..... S FBZADJ=$$ADJ(1)

 ..... S DATA=FBK

 ..... S $P(DATA,U,2)=FBVENID

 ..... S $P(DATA,U,3)=FBDT

 ..... S $P(DATA,U,4)=FBPTSSN

 ..... S $P(DATA,U,5)=$P($$CPT^ICPTCOD(+$P(FBY0,U,1),FBZDOS),U,2)    ; CPT procedure code

 ..... S $P(DATA,U,6)=$$MODS                                         ; comma-delimited list of CPT modifiers

 ..... S $P(DATA,U,7)=$$GET1^DIQ(162.03,FBZIENS,48)                  ; external 3 digit revenue code

 ..... S $P(DATA,U,8)=""

 ..... S $P(DATA,U,9)=""

 ..... S $P(DATA,U,10)=""               ; these are Inpatient or Pharmacy fields

 ..... S $P(DATA,U,11)=""

 ..... S $P(DATA,U,12)=""

 ..... S $P(DATA,U,13)=""

 ..... S $P(DATA,U,14)=$P(FBY0,U,2)     ; amount claimed

 ..... S $P(DATA,U,15)=$P(FBY0,U,3)     ; amount paid

 ..... S $P(DATA,U,16)=$P(FBZADJ,U,1)   ; adjustment amount #1

 ..... S $P(DATA,U,17)=$P(FBZADJ,U,2)   ; adjustment group code-reason code #1

 ..... S $P(DATA,U,18)=$P(FBZADJ,U,3)   ; adjustment amount #2

 ..... S $P(DATA,U,19)=$P(FBZADJ,U,4)   ; adjustment group code-reason code #2

 ..... S $P(DATA,U,20)=$P(FBY0,U,16)    ; fee invoice#

 ..... S $P(DATA,U,21)=$P($G(^FBAA(161.7,+$P(FBY0,U,8),0)),U,1)    ; external batch#

 ..... S $P(DATA,U,22)=$P($G(^FBAA(161.7,+$P(FBY0,U,8),0)),U,2)    ; obligation# from the batch file

 ..... S $P(DATA,U,23)=$P(FBY0,U,14)    ; date paid

 ..... S $P(DATA,U,24)=$P(FBY2,U,3)     ; check number

 ..... S $P(DATA,U,25)=$P(FBY2,U,8)     ; disbursed amount

 ..... S $P(DATA,U,26)=$P(FBY2,U,4)     ; cancellation date

 ..... S $P(DATA,U,27)=$S($P(FBY0,U,21)'="":1,1:0)     ; voided payment flag

 ..... S $P(DATA,U,28)=$$GET1^DIQ(162.03,FBZIENS,19)   ; reject status external value

 ..... ;

 ..... S ^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS)=DATA        ; store data outpat/ancil

 ..... S ^TMP("FBAAIARB",$J,FBVENAME)=FBVENID

 ..... Q

 .... Q

 ... Q

 .. Q

 . Q

COMPOUTX ;

 Q

 ;

MODS() ; Build a list of CPT modifiers for subfile 162.03

 ; Assumes all variables are set from above

 N RET,FBN,MODIEN,MOD

 S RET=""

 S FBN=0 F  S FBN=$O(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",FBN)) Q:'FBN  D

 . S MODIEN=+$P($G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",FBN,0)),U,1) Q:'MODIEN

 . S MOD=$P($$MOD^ICPTMOD(MODIEN,"I",FBZDOS),U,2) Q:MOD=""

 . S RET=$S(RET="":MOD,1:RET_","_MOD)

 . Q

MODSX ;

 Q RET

 ;

ADJ(TYPE) ; Builds a string of Adjustment amounts and group-reason codes

 ; TYPE indicates which payment file to look at to obtain adjustment information

 ; TYPE=1: 162.03  Outpatient/Ancillary

 ; TYPE=2: 162.5   Inpatient

 ; TYPE=3: 162.11  Pharmacy

 ;

 ; Returns a string:

 ;     [1] adjustment amount #1

 ;     [2] adjustment group code-reason code #1

 ;     [3] adjustment amount #2

 ;     [4] adjustment group code-reason code #2

 ;

 N RET,GLO,STOP,Z,G,AMT,GRP,RSN,X

 S RET="",GLO="",STOP=0

 I TYPE=1 S GLO=$NA(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,7))

 I TYPE=2 S GLO=$NA(^FBAAI(FBJ,8))

 I TYPE=3 S GLO=$NA(^FBAA(162.1,FBJ,"RX",FBK,4))

 I GLO="" G ADJX

 ;

 S Z=0 F  S Z=$O(@GLO@(Z)) Q:'Z!STOP  S G=$G(@GLO@(Z,0)) D

 . S AMT=$P(G,U,3)                               ; adj amount

 . S GRP=$P($G(^FB(161.92,+$P(G,U,2),0)),U,1)    ; adj group code

 . S RSN=$P($G(^FB(161.91,+$P(G,U,1),0)),U,1)    ; adj reason code

 . S X=GRP_"-"_RSN

 . I RET="" S RET=AMT_U_X Q       ; 1st adjustment data pair

 . S $P(RET,U,3)=AMT

 . S $P(RET,U,4)=X

 . S STOP=1

 . Q

ADJX ;

 Q RET

 ;

COMPIN ; compile Inpatient data

 ;

 N DATA,DFN,FBDODINV,FBDT,FBJ,FBPTSSN,FBV,FBVENAME,FBVENID,FBY0,FBY2,FBY5,FBYREJ,FBZADJ,FBZDOS,FBZIENS,FBZPTNM,FBZTYPE

 S FBDT=$O(^FBAAI("AD",FBIABEG),-1)

 F  S FBDT=$O(^FBAAI("AD",FBDT)) Q:'FBDT!(FBDT>FBIAEND)  S FBJ=0 F  S FBJ=$O(^FBAAI("AD",FBDT,FBJ)) Q:'FBJ  D

 . S FBY0=$G(^FBAAI(FBJ,0))

 . S FBY2=$G(^FBAAI(FBJ,2))

 . S FBY5=$G(^FBAAI(FBJ,5))

 . S FBYREJ=$G(^FBAAI(FBJ,"FBREJ"))

 . S FBDODINV=$P(FBY5,U,7) I FBDODINV="" Q        ; DoD invoice# must be present

 . S FBV=+$P(FBY0,U,3)      ; vendor ien

 . I '$D(FBIAVEN(FBV)) Q    ; vendor is not among the selected vendors for the report

 . S FBVENAME=$P($G(^FBAAV(FBV,0)),U,1)           ; vendor name

 . I FBVENAME="" S FBVENAME="~unk"

 . S FBVENID=$P($G(^FBAAV(FBV,0)),U,2)            ; vendor external ID

 . S DFN=+$P(FBY0,U,4) Q:'DFN

 . S FBZPTNM=$P($G(^DPT(DFN,0)),U,1) Q:FBZPTNM=""   ; patient name

 . S FBPTSSN=$P($G(^DPT(DFN,0)),U,9)              ; full patient SSN

 . S FBZIENS=FBJ_","                              ; iens

 . S FBZDOS=$$B9ADMIT^FBAAV5(FBZIENS)             ; admission date

 . I 'FBZDOS S FBZDOS=+$P(FBY0,U,6)               ; treatment from date

 . I 'FBZDOS Q                                    ; need to have a date of service

 . I FBIAIGNORE,$P(FBY2,U,5) Q                    ; cancelled

 . I FBIAIGNORE,$P(FBY0,U,14)'="" Q               ; voided

 . I FBIAIGNORE,$P(FBYREJ,U,1)'="" Q              ; rejected

 . I FBIAADJ,$P(FBY0,U,9)'<$P(FBY0,U,8) Q         ; skip paid in full line items

 . ;

 . S FBZTYPE="2-INPAT"

 . S FBZADJ=$$ADJ(2)

 . S DATA=FBV

 . S $P(DATA,U,2)=FBVENID

 . S $P(DATA,U,3)=FBDT

 . S $P(DATA,U,4)=FBPTSSN

 . S $P(DATA,U,5)=""

 . S $P(DATA,U,6)=""

 . S $P(DATA,U,7)=""

 . S $P(DATA,U,8)=$P($$B9DISCHG^FBAAV5(FBZIENS),U,1)                  ; discharge date

 . S $P(DATA,U,9)=$$DIAG                                              ; list of up to 25 Dx & POA codes

 . S $P(DATA,U,10)=$$ICD9^FBCSV1(+$P(FBY5,U,9),FBZDOS)                ; admitting dx

 . S $P(DATA,U,11)=$$PROC                                             ; list of up to 25 proc codes

 . S $P(DATA,U,12)=""

 . S $P(DATA,U,13)=""

 . S $P(DATA,U,14)=$P(FBY0,U,8)     ; amount claimed

 . S $P(DATA,U,15)=$P(FBY0,U,9)     ; amount paid

 . S $P(DATA,U,16)=$P(FBZADJ,U,1)   ; adjustment amount #1

 . S $P(DATA,U,17)=$P(FBZADJ,U,2)   ; adjustment group code-reason code #1

 . S $P(DATA,U,18)=""               ; only 1 adj for inpatient

 . S $P(DATA,U,19)=""

 . S $P(DATA,U,20)=$P(FBY0,U,1)                                 ; fee invoice number

 . S $P(DATA,U,21)=$P($G(^FBAA(161.7,+$P(FBY0,U,17),0)),U,1)    ; external batch#

 . S $P(DATA,U,22)=$P($G(^FBAA(161.7,+$P(FBY0,U,17),0)),U,2)    ; obligation# from the batch file

 . S $P(DATA,U,23)=$P(FBY2,U,1)                                 ; Date Paid

 . S $P(DATA,U,24)=$P(FBY2,U,4)                                 ; check number

 . S $P(DATA,U,25)=$P(FBY2,U,8)                                 ; disbursed amount

 . S $P(DATA,U,26)=$P(FBY2,U,5)                                 ; cancellation date

 . S $P(DATA,U,27)=$S($P(FBY0,U,14)'="":1,1:0)                  ; voided payment flag

 . S $P(DATA,U,28)=$$GET1^DIQ(162.5,FBZIENS,13)                 ; reject status external value

 . ;

 . S ^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS)=DATA                ; store data inpatient

 . S ^TMP("FBAAIARB",$J,FBVENAME)=FBVENID

 . Q

COMPINX ;

 Q

 ;

DIAG() ; capture and format Dx codes and POA codes in a string

 N RET,P1,P2,PCE,DXN,POAN,DX,POA,Z

 S P1=$G(^FBAAI(FBJ,"DX")),P2=$G(^FBAAI(FBJ,"POA"))

 S RET=""

 F PCE=1:1:25 D

 . S DXN=+$P(P1,U,PCE),POAN=+$P(P2,U,PCE) Q:'DXN

 . S DX=$$ICD9^FBCSV1(DXN,FBZDOS) Q:DX=""    ; external diag code

 . S POA=$P($G(^FB(161.94,POAN,0)),U,1)      ; external POA indicator

 . S Z=DX

 . I POA'="" S Z=Z_"("_POA_")"

 . S RET=$S(RET="":Z,1:RET_", "_Z)

 . Q

 Q RET

 ;

PROC() ; capture and format procedure codes into a string

 N RET,P1,PCE,PROCN,PROC

 S P1=$G(^FBAAI(FBJ,"PROC"))

 S RET=""

 F PCE=1:1:25 D

 . S PROCN=+$P(P1,U,PCE) Q:'PROCN                   ; ptr ien to file 80.1

 . S PROC=$$ICD0^FBCSV1(PROCN,FBZDOS) Q:PROC=""     ; external procedure code

 . S RET=$S(RET="":PROC,1:RET_", "_PROC)

 . Q

 Q RET

 ;

COMPRX ; compile Pharmacy data

 ;

 N BCH,DATA,DFN,FBDODINV,FBDT,FBIA,FBINVN,FBJ,FBK,FBPTSSN,FBRXINV,FBVEN,FBVENAME,FBVENID

 N FBY0,FBY2,FBY6,FBYREJ,FBZADJ,FBZDOS,FBZIENS,FBZPTNM,FBZTYPE

 ; loop thru batch file by date finalized for specified date range

 S FBDT=$O(^FBAA(161.7,"AF",FBIABEG),-1)

 F  S FBDT=$O(^FBAA(161.7,"AF",FBDT)) Q:'FBDT!(FBDT>FBIAEND)  D

 . S BCH=0 F  S BCH=$O(^FBAA(161.7,"AF",FBDT,BCH)) Q:'BCH  D

 .. ;

 .. ; loop thru the pharmacy (B5) payments for a batch

 .. S FBJ=0 F  S FBJ=$O(^FBAA(162.1,"AE",BCH,FBJ)) Q:'FBJ  D

 ... S FBRXINV=$G(^FBAA(162.1,FBJ,0))   ; rx invoice level data

 ... S FBVEN=+$P(FBRXINV,U,4)   ; vendor ien

 ... I '$D(FBIAVEN(FBVEN)) Q    ; vendor is not among the selected vendors for report

 ... S FBIA=+$P(FBRXINV,U,23)   ; ipac ptr

 ... I 'FBIA Q                  ; ipac ptr must exist to be included on this report

 ... S FBINVN=$P(FBRXINV,U,1)   ; Rx invoice#

 ... S FBVENAME=$P($G(^FBAAV(FBVEN,0)),U,1)     ; vendor name

 ... I FBVENAME="" S FBVENAME="~unk"

 ... S FBVENID=$P($G(^FBAAV(FBVEN,0)),U,2)      ; vendor external ID

 ... ;

 ... S FBK=0 F  S FBK=$O(^FBAA(162.1,"AE",BCH,FBJ,FBK)) Q:'FBK  D

 .... S FBY0=$G(^FBAA(162.1,FBJ,"RX",FBK,0))

 .... S FBY2=$G(^FBAA(162.1,FBJ,"RX",FBK,2))

 .... S FBY6=$G(^FBAA(162.1,FBJ,"RX",FBK,6))

 .... S FBYREJ=$G(^FBAA(162.1,FBJ,"RX",FBK,"FBREJ"))

 .... S FBDODINV=$P(FBY6,U,1) I FBDODINV="" Q          ; DoD invoice# must be present

 .... I FBIAIGNORE,$P(FBY2,U,11) Q                     ; cancelled

 .... I FBIAIGNORE,$P(FBY2,U,3)'="" Q                  ; voided

 .... I FBIAIGNORE,$P(FBYREJ,U,1)'="" Q                ; rejected

 .... I FBIAADJ,$P(FBY0,U,16)'<$P(FBY0,U,4) Q          ; skip paid in full line items

 .... S DFN=+$P(FBY0,U,5) Q:'DFN                       ; patient ien

 .... S FBZPTNM=$P($G(^DPT(DFN,0)),U,1) Q:FBZPTNM=""   ; patient name

 .... S FBPTSSN=$P($G(^DPT(DFN,0)),U,9)                ; full patient SSN

 .... S FBZIENS=FBK_","_FBJ_","                        ; iens

 .... S FBZDOS=+$P(FBY0,U,3) Q:'FBZDOS                 ; date prescription filled is DOS

 .... ;

 .... S FBZTYPE="3-RX"

 .... S FBZADJ=$$ADJ(3)

 .... S DATA=FBVEN

 .... S $P(DATA,U,2)=FBVENID

 .... S $P(DATA,U,3)=FBDT

 .... S $P(DATA,U,4)=FBPTSSN

 .... S $P(DATA,U,5)=""

 .... S $P(DATA,U,6)=""

 .... S $P(DATA,U,7)=""

 .... S $P(DATA,U,8)=""

 .... S $P(DATA,U,9)=""

 .... S $P(DATA,U,10)=""

 .... S $P(DATA,U,11)=""

 .... S $P(DATA,U,12)=$P(FBY0,U,1)     ; prescription#

 .... S $P(DATA,U,13)=$P(FBY0,U,2)     ; drug name

 .... S $P(DATA,U,14)=$P(FBY0,U,4)     ; amount claimed

 .... S $P(DATA,U,15)=$P(FBY0,U,16)    ; amount paid

 .... S $P(DATA,U,16)=$P(FBZADJ,U,1)   ; adjustment amount #1

 .... S $P(DATA,U,17)=$P(FBZADJ,U,2)   ; adjustment group code-reason code #1

 .... S $P(DATA,U,18)=$P(FBZADJ,U,3)   ; adjustment amount #2

 .... S $P(DATA,U,19)=$P(FBZADJ,U,4)   ; adjustment group code-reason code #2

 .... S $P(DATA,U,20)=FBINVN                                       ; fee invoice number

 .... S $P(DATA,U,21)=$P($G(^FBAA(161.7,+$P(FBY0,U,17),0)),U,1)    ; external batch#

 .... S $P(DATA,U,22)=$P($G(^FBAA(161.7,+$P(FBY0,U,17),0)),U,2)    ; obligation# from the batch file

 .... S $P(DATA,U,23)=$P(FBY2,U,8)                                 ; Date Paid

 .... S $P(DATA,U,24)=$P(FBY2,U,10)                                ; check number

 .... S $P(DATA,U,25)=$P(FBY2,U,14)                                ; disbursed amount

 .... S $P(DATA,U,26)=$P(FBY2,U,11)                                ; cancellation date

 .... S $P(DATA,U,27)=$S($P(FBY2,U,3)'="":1,1:0)                   ; voided payment flag

 .... S $P(DATA,U,28)=$$GET1^DIQ(162.11,FBZIENS,17)                ; reject status external value

 .... ;

 .... S ^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS)=DATA                ; store data pharmacy

 .... S ^TMP("FBAAIARB",$J,FBVENAME)=FBVENID

 .... ;

 .... Q

 ... Q

 .. Q

 . Q

COMPRXX ;

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAAIARC   14788     printed  Mar 13, 2025@21:00:22                                                                                                                                                                                                   Page 2

FBAAIARC  ;ALB/ESG - FEE IPAC Vendor Payment Report (Detail) Compile continued ;2/4/2014

 +1       ;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4        QUIT 

 +5       ;

COMPILE   ; entry point for the compile to build the scratch global

 +1       ; may be background task if job queued

 +2       ;

 +3        KILL ^TMP("FBAAIARB",$JOB)

 +4        IF '$DATA(ZTQUEUED)

               WRITE !!,"Compiling IPAC Vendor Payment Report.  Please wait ... "

 +5       ; outpatient/ancillary

           IF $DATA(FBIATYPE("OUT"))!$DATA(FBIATYPE("ANC"))

               DO COMPOUT

 +6       ; inpatient

           IF $DATA(FBIATYPE("INP"))

               DO COMPIN

 +7       ; prescription

           IF $DATA(FBIATYPE("RX"))

               DO COMPRX

 +8       ;

 +9       ; print report

           DO PRINT^FBAAIARD

 +10      ; close the device

           DO ^%ZISC

 +11      ; kill scratch

           KILL ^TMP("FBAAIARB",$JOB)

 +12      ; purge the task

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

COMPILX   ;

 +1        QUIT 

 +2       ;

COMPOUT   ; compile Outpatient and Ancillary data

 +1       ;

 +2        NEW DATA,FBDODINV,FBDT,FBJ,FBK,FBL,FBM,FBPTSSN,FBVENAME,FBVENID

 +3        NEW FBY0,FBY2,FBY3,FBYREJ,FBZADJ,FBZDOS,FBZIENS,FBZPTNM,FBZTYPE,FEEPROG

 +4        SET FBDT=$ORDER(^FBAAC("AK",FBIABEG),-1)

 +5        FOR 

               SET FBDT=$ORDER(^FBAAC("AK",FBDT))

               if 'FBDT!(FBDT>FBIAEND)

                   QUIT 

               Begin DoDot:1

 +6       ; FBJ=patient DFN

                   SET FBJ=0

                   FOR 

                       SET FBJ=$ORDER(^FBAAC("AK",FBDT,FBJ))

                       if 'FBJ

                           QUIT 

                       Begin DoDot:2

 +7       ; patient name for scratch global

                           SET FBZPTNM=$PIECE($GET(^DPT(FBJ,0)),U,1)

                           if FBZPTNM=""

                               QUIT 

 +8       ; full patient SSN

                           SET FBPTSSN=$PIECE($GET(^DPT(FBJ,0)),U,9)

 +9       ; FBK=vendor ien

                           SET FBK=0

                           FOR 

                               SET FBK=$ORDER(^FBAAC("AK",FBDT,FBJ,FBK))

                               if 'FBK

                                   QUIT 

                               Begin DoDot:3

 +10      ; make sure vendor is among the selected vendors for the report

                                   IF '$DATA(FBIAVEN(FBK))

                                       QUIT 

 +11      ; vendor name

                                   SET FBVENAME=$PIECE($GET(^FBAAV(FBK,0)),U,1)

 +12                               IF FBVENAME=""

                                       SET FBVENAME="~unk"

 +13      ; vendor external ID

                                   SET FBVENID=$PIECE($GET(^FBAAV(FBK,0)),U,2)

 +14                               SET FBL=0

                                   FOR 

                                       SET FBL=$ORDER(^FBAAC("AK",FBDT,FBJ,FBK,FBL))

                                       if 'FBL

                                           QUIT 

                                       Begin DoDot:4

 +15      ; initial treatment date (DOS) for scratch global

                                           SET FBZDOS=+$PIECE($GET(^FBAAC(FBJ,1,FBK,1,FBL,0)),U,1)

                                           if 'FBZDOS

                                               QUIT 

 +16                                       SET FBM=0

                                           FOR 

                                               SET FBM=$ORDER(^FBAAC("AK",FBDT,FBJ,FBK,FBL,FBM))

                                               if 'FBM

                                                   QUIT 

                                               Begin DoDot:5

 +17                                               SET FBY0=$GET(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0))

 +18      ; Fee Program ptr

                                                   SET FEEPROG=+$PIECE(FBY0,U,9)

 +19      ; Outpatient not a chosen type for report

                                                   IF FEEPROG=2

                                                       IF '$DATA(FBIATYPE("OUT"))

                                                           QUIT 

 +20      ; Civil Hosp Ancillary not a chosen type for report

                                                   IF FEEPROG'=2

                                                       IF '$DATA(FBIATYPE("ANC"))

                                                           QUIT 

 +21      ; type subscript for scratch global

                                                   SET FBZTYPE=$SELECT(FEEPROG=2:"1-OUTPAT",1:"4-ANCIL")

 +22                                               SET FBY2=$GET(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,2))

 +23                                               SET FBY3=$GET(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,3))

 +24                                               SET FBYREJ=$GET(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"FBREJ"))

 +25      ; DoD invoice# must be present

                                                   SET FBDODINV=$PIECE(FBY3,U,7)

                                                   IF FBDODINV=""

                                                       QUIT 

 +26      ; cancellation date exists

                                                   IF FBIAIGNORE

                                                       IF $PIECE(FBY2,U,4)

                                                           QUIT 

 +27      ; line has been voided

                                                   IF FBIAIGNORE

                                                       IF $PIECE(FBY0,U,21)'=""

                                                           QUIT 

 +28      ; line has been rejected

                                                   IF FBIAIGNORE

                                                       IF $PIECE(FBYREJ,U,1)'=""

                                                           QUIT 

 +29      ; skip paid in full line items

                                                   IF FBIAADJ

                                                       IF $PIECE(FBY0,U,3)'<$PIECE(FBY0,U,2)

                                                           QUIT 

 +30      ;

 +31      ; iens

                                                   SET FBZIENS=FBM_","_FBL_","_FBK_","_FBJ_","

 +32                                               SET FBZADJ=$$ADJ(1)

 +33                                               SET DATA=FBK

 +34                                               SET $PIECE(DATA,U,2)=FBVENID

 +35                                               SET $PIECE(DATA,U,3)=FBDT

 +36                                               SET $PIECE(DATA,U,4)=FBPTSSN

 +37      ; CPT procedure code

                                                   SET $PIECE(DATA,U,5)=$PIECE($$CPT^ICPTCOD(+$PIECE(FBY0,U,1),FBZDOS),U,2)

 +38      ; comma-delimited list of CPT modifiers

                                                   SET $PIECE(DATA,U,6)=$$MODS

 +39      ; external 3 digit revenue code

                                                   SET $PIECE(DATA,U,7)=$$GET1^DIQ(162.03,FBZIENS,48)

 +40                                               SET $PIECE(DATA,U,8)=""

 +41                                               SET $PIECE(DATA,U,9)=""

 +42      ; these are Inpatient or Pharmacy fields

                                                   SET $PIECE(DATA,U,10)=""

 +43                                               SET $PIECE(DATA,U,11)=""

 +44                                               SET $PIECE(DATA,U,12)=""

 +45                                               SET $PIECE(DATA,U,13)=""

 +46      ; amount claimed

                                                   SET $PIECE(DATA,U,14)=$PIECE(FBY0,U,2)

 +47      ; amount paid

                                                   SET $PIECE(DATA,U,15)=$PIECE(FBY0,U,3)

 +48      ; adjustment amount #1

                                                   SET $PIECE(DATA,U,16)=$PIECE(FBZADJ,U,1)

 +49      ; adjustment group code-reason code #1

                                                   SET $PIECE(DATA,U,17)=$PIECE(FBZADJ,U,2)

 +50      ; adjustment amount #2

                                                   SET $PIECE(DATA,U,18)=$PIECE(FBZADJ,U,3)

 +51      ; adjustment group code-reason code #2

                                                   SET $PIECE(DATA,U,19)=$PIECE(FBZADJ,U,4)

 +52      ; fee invoice#

                                                   SET $PIECE(DATA,U,20)=$PIECE(FBY0,U,16)

 +53      ; external batch#

                                                   SET $PIECE(DATA,U,21)=$PIECE($GET(^FBAA(161.7,+$PIECE(FBY0,U,8),0)),U,1)

 +54      ; obligation# from the batch file

                                                   SET $PIECE(DATA,U,22)=$PIECE($GET(^FBAA(161.7,+$PIECE(FBY0,U,8),0)),U,2)

 +55      ; date paid

                                                   SET $PIECE(DATA,U,23)=$PIECE(FBY0,U,14)

 +56      ; check number

                                                   SET $PIECE(DATA,U,24)=$PIECE(FBY2,U,3)

 +57      ; disbursed amount

                                                   SET $PIECE(DATA,U,25)=$PIECE(FBY2,U,8)

 +58      ; cancellation date

                                                   SET $PIECE(DATA,U,26)=$PIECE(FBY2,U,4)

 +59      ; voided payment flag

                                                   SET $PIECE(DATA,U,27)=$SELECT($PIECE(FBY0,U,21)'="":1,1:0)

 +60      ; reject status external value

                                                   SET $PIECE(DATA,U,28)=$$GET1^DIQ(162.03,FBZIENS,19)

 +61      ;

 +62      ; store data outpat/ancil

                                                   SET ^TMP("FBAAIARB",$JOB,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS)=DATA

 +63                                               SET ^TMP("FBAAIARB",$JOB,FBVENAME)=FBVENID

 +64                                               QUIT 

                                               End DoDot:5

 +65                                       QUIT 

                                       End DoDot:4

 +66                               QUIT 

                               End DoDot:3

 +67                       QUIT 

                       End DoDot:2

 +68               QUIT 

               End DoDot:1

COMPOUTX  ;

 +1        QUIT 

 +2       ;

MODS()    ; Build a list of CPT modifiers for subfile 162.03

 +1       ; Assumes all variables are set from above

 +2        NEW RET,FBN,MODIEN,MOD

 +3        SET RET=""

 +4        SET FBN=0

           FOR 

               SET FBN=$ORDER(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",FBN))

               if 'FBN

                   QUIT 

               Begin DoDot:1

 +5                SET MODIEN=+$PIECE($GET(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",FBN,0)),U,1)

                   if 'MODIEN

                       QUIT 

 +6                SET MOD=$PIECE($$MOD^ICPTMOD(MODIEN,"I",FBZDOS),U,2)

                   if MOD=""