Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAAIARC

FBAAIARC.m

Go to the documentation of this file.
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
 ;