FBAAIAR1 ;ALB/FA - FEE IPAC Vendor DoD Invoice Number Inquiry Report ;1/16/2014
;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
;;Per VA Directive 6402, this routine should not be modified.
;
;
;-----------------------------------------------------------------------------
; Entry Points
; EN - DoD Invoice Inquiry Report - Run report
;-----------------------------------------------------------------------------
;
Q
;
EN ;EP
; Main report entry point
N FBDODINV,FBFORMAT
Q:'$$DODISEL(.FBDODINV) ; Select DoD Invoice number
Q:'$$FORMAT(.FBFORMAT) ; Select Report Format
Q:$$DEVICE(FBDODINV,FBFORMAT) ; Select Device and compile report
Q
;
DODISEL(FBDODINV) ; Ask for the DoD Invoice
; Input: None
; Output: FBDODINV - Selected DoD Invoice Number
; Returns: 1 - User quit out, 0 otherwise
; Called From: EN
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RET,X,Y
S RET=1 ; Assume DoD Invoice Selection
W @IOF,!,"IPAC Vendor DoD Invoice Number Inquiry Report"
W !!,"This report will display all of the VistA invoices for the "
W !,"selected DoD Invoice Number."
W !
S DIR(0)="F^3:22"
S DIR("A")="DoD Invoice Number"
S DIR("?",1)="All of the associated VistA invoices will be displayed for the"
S DIR("?",2)="selected DoD invoice number"
W ! D ^DIR K DIR
I $D(DIRUT)!(Y="") D
. S RET=0 ; User wants to exit
. W *7
S FBDODINV=Y ; Selected DoD Invoice number
Q RET
;
FORMAT(FBFORMAT) ; Capture the report format from the user (normal or CSV output)
; Input: None
; Output: FBFORMAT - 1 - CSV Format, 0 otherwise
; Returns: 0 - User quit out, 1 otherwise
; Called From: EN
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,RET,X,Y
S RET=1
S DIR(0)="Y"
S DIR("A")="Do you want to capture the output in a CSV format"
S DIR("B")="NO"
S DIR("?",1)="If you want to capture the output from this report in a comma-separated"
S DIR("?",2)="values (CSV) format, then answer YES here. A CSV format is something that"
S DIR("?",3)="could be easily imported into a spreadsheet program like Excel."
S DIR("?",4)=" "
S DIR("?")="If you just want a normal report output, then answer NO here."
W ! D ^DIR K DIR
I $D(DIRUT) D
. S RET=0 ; User wants to exit
. W *7
S FBFORMAT=Y
Q RET
;
DEVICE(FBDODINV,FBFORMAT) ; Device Selection and Report compilation
; Input: FBDODINV - DoD invoice number to compile VistA invoices for
; FBFORMAT - 1 - CSV Format, 0 otherwise
; Output: Report is compiled if a device is selected
; Returns: 1 - User quit out, 0 otherwise
; Called From: EN
N DIR,POP,RET,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
S RET=1
I 'FBFORMAT D
. W !!,"This report is 80 characters wide. Please choose an appropriate device.",!
E D
. W !!,"For CSV output, turn logging or capture on now."
. W !,"To avoid undesired wrapping of the data saved to the file,"
. W !,"please enter ""0;256;99999"" at the ""DEVICE:"" prompt.",!
;
S ZTRTN="COMPILE^FBAAIAR1"
S ZTDESC="Fee Basis IPAC Vendor DoD Invoice Inquiry Report"
S ZTSAVE("FBDODINV")=""
S ZTSAVE("FBFORMAT")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
S:POP RET=0
I $G(ZTSK) D
. W !!,"Report compilation has started with task# ",ZTSK,".",!
. S DIR(0)="E"
. D ^DIR
Q RET
;
COMPILE ; Entry point for the compile to build the scratch global
; may be background task if job queued
; Input: FBDODINV - DoD Invoice number to use for selection
; FBFORMAT - 1 - CSV format, 0 otherwise
; Output: Report is compiled and output
; Called From: Report processing
;
K ^TMP("FBAAIAR1",$J)
I '$D(ZTQUEUED) W !!,"Compiling IPAC Vendor DoD Invoice Inquiry Report. Please wait ... "
D COMPOUT(FBDODINV) ; Compile Outpatient invoices
D COMPIN(FBDODINV) ; Compile Inpatient invoices
D COMPRX(FBDODINV) ; Compile Pharmacy invoices
;
D PRINT^FBAAIAR2(FBDODINV,FBFORMAT) ; Print report
D ^%ZISC ; Close the device
K ^TMP("FBAAIAR1",$J) ; Kill scratch global
S:$D(ZTQUEUED) ZTREQ="@" ; Purge the task
Q
;
COMPOUT(FBDODINV) ; Compile Outpatient and Inpatient Ancillary Invoice data
; Input: FBDODINV - DoD Invoice number to use for selection
; Output: VistA invoices for the selected DoD invoice number are
; added to the temporary global
; Called From: COMPILE
;
N DATA,IDTIEN,PATIEN,SVCIEN,VENIEN,VNAME
S PATIEN=""
F D Q:PATIEN="" ; Patient IEN
. S PATIEN=$O(^FBAAC("DODI",FBDODINV,PATIEN))
. Q:PATIEN=""
. S VENIEN=""
. F D Q:VENIEN="" ; Vendor IEN
. . S VENIEN=$O(^FBAAC("DODI",FBDODINV,PATIEN,VENIEN))
. . Q:VENIEN=""
. . S VNAME=$P($G(^FBAAV(VENIEN,0)),U,1) ; Vendor Name
. . S IDTIEN=""
. . F D Q:IDTIEN="" ; Initial Service Date IEN
. . . S IDTIEN=$O(^FBAAC("DODI",FBDODINV,PATIEN,VENIEN,IDTIEN))
. . . Q:IDTIEN=""
. . . S SVCIEN=""
. . . F D Q:SVCIEN="" ; Service Provided IEN
. . . . S SVCIEN=$O(^FBAAC("DODI",FBDODINV,PATIEN,VENIEN,IDTIEN,SVCIEN))
. . . . Q:SVCIEN=""
. . . . ;
. . . . ; Store the row data for the invoice into the temporary global
. . . . D ROWDATAO(VNAME,PATIEN,VENIEN,IDTIEN,SVCIEN)
Q
;
ROWDATAO(VNAME,PATIEN,VENIEN,IDTIEN,SVCIEN) ;
; Retrieves the information needed to display the VistA invoice row for an
; outpatient invoice or an Inpatient Ancillary invoice.
; Input: VNAME - Vendor Name of the Invoice
; PATIEN - Patient IEN
; VENIEN - Vendor IEN of the invoice
; IDTIEN - Internal Initial Treatment Date IEN
; SVCIEN - Invoice IEN
; ^TMP("FAAIAR1",$J) - Current temporary file
; Output: ^TMP("FAAIAR1",$J) - Updated with VistA Invoice data
; Called From: COMPOUT
;
N DATA,INV0,INV2,INV3,INVNUM,TYPE,XX
S INV0=$G(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,0)) ; Outpatient Invoice 0 Node
S INV2=$G(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,2)) ; Outpatient Invoice 2 Node
S INV3=$G(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,3)) ; Outpatient Invoice 3 Node
S INVNUM=$P(INV0,U,16) ; VistA Invoice #
S ITYPE=+$P(INV0,U,9) ; Fee Program ptr
S ITYPE=$S(ITYPE=2:0,1:1) ; 0 - Outpatient, 1: Inpatient Ancillary
S TYPE=$S('ITYPE:"OUT",1:"ANC")
S DATA=$$GETTYPEO(PATIEN,VENIEN,IDTIEN,SVCIEN,INV0,INV2) ; Void/Purge/Cancel flags
S $P(DATA,U,2)=$P(INV0,U,14) ; Date Paid
S $P(DATA,U,3)=$P(INV0,U,2) ; Amount Claimed
S $P(DATA,U,4)=$P(INV0,U,3) ; Amount Paid
S $P(DATA,U,5)=$P(INV0,U,4) ; Amount Adjusted
S XX=IDTIEN_"-"_SVCIEN
S ^TMP("FBAAIAR1",$J,VNAME,TYPE,INVNUM,XX)=DATA ; VistA invoice data for the invoice
D TOTS(VNAME,TYPE,INVNUM,DATA) ; Gather totals for invoice
Q
;
GETTYPEO(PATIEN,VENIEN,IDTIEN,SVCIEN,INV0,INV2) ; Determines if the invoice has been
; cancelled, rejected, purged or voided or some combination
; Input: PATIEN - Patient IEN
; VENIEN - Vendor IEN
; IDTIEN - Initial Treatment Date IEN
; SVCIEN - Service Provided IEN
; INV0 - 0 node of the outpatient invoice
; INV2 - 2 node of the outpatient invoice
; Returns: V - Voided
; C - Cancelled
; R - Rejected
; P - Purged
; "" - Otherwise
; or any combination of C/V/R/P
; Called From: ROWDATAO
N VAL
S VAL=""
S:$D(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,"FBREJC")) VAL="R" ; Rejected
S:$D(^FBAAC(PATIEN,"PURGE",VENIEN,0)) VAL=VAL_"P" ; Purged
S:$P(INV2,U,4)'="" VAL=VAL_"C" ; Cancelled
S:$P(INV0,U,21)'="" VAL=VAL_"V" ; Voided
Q VAL
;
COMPIN(FBDODINV) ; Compile Inpatient Invoice data
; Input: FBDODINV - DoD Invoice number to use for selection
; ^TMP("FAAIAR1",$J) - Current temporary file
; Output: ^TMP("FAAIAR1",$J) - Updated with VistA Invoice data
; Called From: COMPILE
;
N DATA,INIEN,INVNUM,INV0,INV2,INV5,ITYPE,VNAME,XX
S INIEN=""
F D Q:INIEN="" ; Inpatient Invoice by DoD Invoice #
. S INIEN=$O(^FBAAI("DODI",FBDODINV,INIEN))
. Q:INIEN=""
. S INV0=$G(^FBAAI(INIEN,0))
. S INV2=$G(^FBAAI(INIEN,2))
. S INV5=$G(^FBAAI(INIEN,5))
. S XX=+$P(INV0,U,3) ; Vendor IEN
. S VNAME=$P($G(^FBAAV(XX,0)),U,1) ; Vendor Name
. S INVNUM=$P(INV0,U,1) ; VistA Invoice #
. S DATA=$$GETTYPEI(INIEN,INV0,INV2) ; Type of Record
. S $P(DATA,U,2)=$P(INV2,U,1) ; Date Paid
. S $P(DATA,U,3)=$P(INV0,U,8) ; Amount Claimed
. S $P(DATA,U,4)=$P(INV0,U,9) ; Amount Paid
. S $P(DATA,U,5)=$P(INV0,U,10) ; Amount Adjusted
. S ^TMP("FBAAIAR1",$J,VNAME,"INP",INVNUM,0)=DATA ; VistA invoice data for invoice
. D TOTS(VNAME,"INP",INVNUM,DATA) ; Gather totals for invoice
Q
;
GETTYPEI(INVIEN,INV0,INV2) ; Determines if the inpatient invoice has been
; cancelled, rejected or voided or some combination
; Input: INVIEN - IEN of the inpatient invoice
; INV0 - 0 node of the inpatient invoice
; INV2 - 2 node of the inpatient invoice
; INV5 - 5 node of the inpatient invoice
; Returns: V - Voided
; C - Cancelled
; R - Rejected
; "" - Otherwise
; or any combination of C/V/R
; Called From: COMPIN
N VAL
S VAL=""
S:$D(^FBAAI(INVIEN,"FBREJ")) VAL="R" ; Rejected
S:$P(INV2,U,5)'="" VAL=VAL_"C" ; Cancelled
S:$P(INV0,U,14)'="" VAL=VAL_"V" ; Voided
Q VAL
;
COMPRX(FBDODINV) ; Compile Pharmacy invoice data
; Input: FBDODINV - DoD Invoice number to use for selection
; ^TMP("FAAIAR1",$J) - Current temporary file
; Output: ^TMP("FAAIAR1",$J) - Updated with VistA Invoice data
; Called From: COMPILE
;
N AMTA,AMTC,AMTP,DATA,DATEP,INVNUM,INV0,INV2,ITYPE,ITYPE2
N PHIEN,RXIEN,RXINV,VNAME,XX
S PHIEN="",DATEP="",ITYPE2=""
F D Q:PHIEN="" ; Pharmacy Invoice by DoD Invoice #
. S PHIEN=$O(^FBAA(162.1,"DODI",FBDODINV,PHIEN))
. Q:PHIEN=""
. S (AMTA,AMTC,AMTP)=0 ; Init amount tots for invoice
. S RXINV=$G(^FBAA(162.1,PHIEN,0)) ; Invoice level data
. S XX=+$P(RXINV,U,4) ; Vendor IEN
. S VNAME=$P($G(^FBAAV(XX,0)),U,1) ; Vendor name
. S INVNUM=$P(RXINV,U,1) ; VistA Invoice #
. S RXIEN=""
. F D Q:RXIEN="" ; Prescription level
. . S RXIEN=$O(^FBAA(162.1,"DODI",FBDODINV,PHIEN,RXIEN))
. . Q:RXIEN=""
. . S INV0=$G(^FBAA(162.1,PHIEN,"RX",RXIEN,0)) ; Prescription 0 Node
. . S INV2=$G(^FBAA(162.1,PHIEN,"RX",RXIEN,2)) ; Prescription 2 Node
. . D GETTYPEP(PHIEN,RXIEN,INV2,.ITYPE2) ; Type of Pharmacy Record
. . S XX=$P(INV2,U,8) ; Date Paid
. . S DATEP=$S(DATEP="":XX,XX<DATEP:XX,1:DATEP) ; Find the lowest date paid
. . S AMTC=AMTC+$P(INV0,U,4) ; Amount Claimed
. . S AMTP=AMTP+$P(INV0,U,16) ; Amount Paid
. . S AMTA=AMTA+$P(INV0,U,7) ; Amount Adjusted
. S DATA=ITYPE2 ; Pharmacy Invoice Void/Cancel/Reject
. S $P(DATA,U,2)=DATEP ; Lowest date paid
. S $P(DATA,U,3)=AMTC ; Total Amount claimed for Invoice
. S $P(DATA,U,4)=AMTP ; Total Amount paid for Invoice
. S $P(DATA,U,5)=AMTA ; Total Amount adjusted for Invoice
. S ^TMP("FBAAIAR1",$J,VNAME,"RX",INVNUM,0)=DATA ; VistA invoice data for invoice
. D TOTS(VNAME,"RX",INVNUM,DATA) ; Gather totals for DoD invoice#
Q
;
GETTYPEP(PHIEN,RXIEN,INV2,ITYPE) ; Determines if the pharmacy invoice has any
; cancelled, rejected or voided prescriptions.
; Input: PHIEN - IEN of the pharmacy invoice
; RXIEN - Prescription IEN
; INV2 - 2 node of the pharmacy prescription invoice
; ITYPE - Current value for the pharmacy invoice
; Output: ITYPE - Updated value for the pharmacy invoice
; Called From: COMPRX
I $D(^FBAA(162.1,PHIEN,"RX",RXIEN,"FBREJ")) D ; Rejected
. S ITYPE=$S(ITYPE'["R":ITYPE_"R",1:ITYPE)
I $P(INV2,U,11)'="" D Q ; Cancelled
. S ITYPE=$S(ITYPE'["C":ITYPE_"C",1:ITYPE)
I $P(INV2,U,3)'="" D Q ; Voided
. S ITYPE=$S(ITYPE'["V":ITYPE_"V",1:ITYPE)
Q
;
TOTS(VNAME,TYPE,INVNUM,DATA) ; Gather totals and other data for all invoices for
; the specified DoD invoice#. Update the scratch global with information
; Input: VNAME - Vendor Name
; TYPE - "OUT" - Outpatient Invoice
; "ANC" - Inpatient Ancillary Invoice
; "INP" - Inpatient Invoice
; "RX" - Pharmacy Invoice
; INVNUM - VistA Invoice Number
; DATA - ^TMP("FBAAIAR1",$J,VNAME,TYPE,INVNUM)
; ^TMP("FBAAIAR1",$J,VNAME) - Current DoD Invoice Vendor totals
; ^TMP("FBAAIAR1",$J,VNAME,TYPE) - Current Type totals
; Output: ^TMP("FBAAIAR1",$J,VNAME) - Updated DoD Invoice Vendor totals
; ^TMP("FBAAIAR1",$J,VNAME,TYPE) - Updated Type totals
; Called From: COMPIN, COMPOUT, COMPRX
;
N CURTOT
S CURTOT=$G(^TMP("FBAAIAR1",$J,VNAME)) ; Current DoD Invoice Vendor totals
S $P(CURTOT,U,1)=$P(DATA,U,3)+$P(CURTOT,U,1) ; New Claimed Total
S $P(CURTOT,U,2)=$P(DATA,U,4)+$P(CURTOT,U,2) ; New Paid Total
S $P(CURTOT,U,3)=$P(DATA,U,5)+$P(CURTOT,U,3) ; New Adjustment Total
S $P(CURTOT,U,4)=$P(CURTOT,U,4)+1 ; New Invoice count
S ^TMP("FBAAIAR1",$J,VNAME)=CURTOT
S CURTOT=$G(^TMP("FBAAIAR1",$J,VNAME,TYPE)) ; Current DoD Invoice Vendor totals by type
S $P(CURTOT,U,1)=$P(DATA,U,3)+$P(CURTOT,U,1) ; New Claimed Total
S $P(CURTOT,U,2)=$P(DATA,U,4)+$P(CURTOT,U,2) ; New Paid Total
S $P(CURTOT,U,3)=$P(DATA,U,5)+$P(CURTOT,U,3) ; New Adjustment Total
S $P(CURTOT,U,4)=$P(CURTOT,U,4)+1 ; New Invoice count by type
S ^TMP("FBAAIAR1",$J,VNAME,TYPE)=CURTOT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAIAR1 15995 printed Sep 23, 2025@19:31:40 Page 2
FBAAIAR1 ;ALB/FA - FEE IPAC Vendor DoD Invoice Number Inquiry Report ;1/16/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 ;
+5 ;-----------------------------------------------------------------------------
+6 ; Entry Points
+7 ; EN - DoD Invoice Inquiry Report - Run report
+8 ;-----------------------------------------------------------------------------
+9 ;
+10 QUIT
+11 ;
EN ;EP
+1 ; Main report entry point
+2 NEW FBDODINV,FBFORMAT
+3 ; Select DoD Invoice number
if '$$DODISEL(.FBDODINV)
QUIT
+4 ; Select Report Format
if '$$FORMAT(.FBFORMAT)
QUIT
+5 ; Select Device and compile report
if $$DEVICE(FBDODINV,FBFORMAT)
QUIT
+6 QUIT
+7 ;
DODISEL(FBDODINV) ; Ask for the DoD Invoice
+1 ; Input: None
+2 ; Output: FBDODINV - Selected DoD Invoice Number
+3 ; Returns: 1 - User quit out, 0 otherwise
+4 ; Called From: EN
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RET,X,Y
+7 ; Assume DoD Invoice Selection
SET RET=1
+8 WRITE @IOF,!,"IPAC Vendor DoD Invoice Number Inquiry Report"
+9 WRITE !!,"This report will display all of the VistA invoices for the "
+10 WRITE !,"selected DoD Invoice Number."
+11 WRITE !
+12 SET DIR(0)="F^3:22"
+13 SET DIR("A")="DoD Invoice Number"
+14 SET DIR("?",1)="All of the associated VistA invoices will be displayed for the"
+15 SET DIR("?",2)="selected DoD invoice number"
+16 WRITE !
DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)!(Y="")
Begin DoDot:1
+18 ; User wants to exit
SET RET=0
+19 WRITE *7
End DoDot:1
+20 ; Selected DoD Invoice number
SET FBDODINV=Y
+21 QUIT RET
+22 ;
FORMAT(FBFORMAT) ; Capture the report format from the user (normal or CSV output)
+1 ; Input: None
+2 ; Output: FBFORMAT - 1 - CSV Format, 0 otherwise
+3 ; Returns: 0 - User quit out, 1 otherwise
+4 ; Called From: EN
+5 ;
+6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,RET,X,Y
+7 SET RET=1
+8 SET DIR(0)="Y"
+9 SET DIR("A")="Do you want to capture the output in a CSV format"
+10 SET DIR("B")="NO"
+11 SET DIR("?",1)="If you want to capture the output from this report in a comma-separated"
+12 SET DIR("?",2)="values (CSV) format, then answer YES here. A CSV format is something that"
+13 SET DIR("?",3)="could be easily imported into a spreadsheet program like Excel."
+14 SET DIR("?",4)=" "
+15 SET DIR("?")="If you just want a normal report output, then answer NO here."
+16 WRITE !
DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)
Begin DoDot:1
+18 ; User wants to exit
SET RET=0
+19 WRITE *7
End DoDot:1
+20 SET FBFORMAT=Y
+21 QUIT RET
+22 ;
DEVICE(FBDODINV,FBFORMAT) ; Device Selection and Report compilation
+1 ; Input: FBDODINV - DoD invoice number to compile VistA invoices for
+2 ; FBFORMAT - 1 - CSV Format, 0 otherwise
+3 ; Output: Report is compiled if a device is selected
+4 ; Returns: 1 - User quit out, 0 otherwise
+5 ; Called From: EN
+6 NEW DIR,POP,RET,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+7 SET RET=1
+8 IF 'FBFORMAT
Begin DoDot:1
+9 WRITE !!,"This report is 80 characters wide. Please choose an appropriate device.",!
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 WRITE !!,"For CSV output, turn logging or capture on now."
+12 WRITE !,"To avoid undesired wrapping of the data saved to the file,"
+13 WRITE !,"please enter ""0;256;99999"" at the ""DEVICE:"" prompt.",!
End DoDot:1
+14 ;
+15 SET ZTRTN="COMPILE^FBAAIAR1"
+16 SET ZTDESC="Fee Basis IPAC Vendor DoD Invoice Inquiry Report"
+17 SET ZTSAVE("FBDODINV")=""
+18 SET ZTSAVE("FBFORMAT")=""
+19 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,"QM",1)
+20 if POP
SET RET=0
+21 IF $GET(ZTSK)
Begin DoDot:1
+22 WRITE !!,"Report compilation has started with task# ",ZTSK,".",!
+23 SET DIR(0)="E"
+24 DO ^DIR
End DoDot:1
+25 QUIT RET
+26 ;
COMPILE ; Entry point for the compile to build the scratch global
+1 ; may be background task if job queued
+2 ; Input: FBDODINV - DoD Invoice number to use for selection
+3 ; FBFORMAT - 1 - CSV format, 0 otherwise
+4 ; Output: Report is compiled and output
+5 ; Called From: Report processing
+6 ;
+7 KILL ^TMP("FBAAIAR1",$JOB)
+8 IF '$DATA(ZTQUEUED)
WRITE !!,"Compiling IPAC Vendor DoD Invoice Inquiry Report. Please wait ... "
+9 ; Compile Outpatient invoices
DO COMPOUT(FBDODINV)
+10 ; Compile Inpatient invoices
DO COMPIN(FBDODINV)
+11 ; Compile Pharmacy invoices
DO COMPRX(FBDODINV)
+12 ;
+13 ; Print report
DO PRINT^FBAAIAR2(FBDODINV,FBFORMAT)
+14 ; Close the device
DO ^%ZISC
+15 ; Kill scratch global
KILL ^TMP("FBAAIAR1",$JOB)
+16 ; Purge the task
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+17 QUIT
+18 ;
COMPOUT(FBDODINV) ; Compile Outpatient and Inpatient Ancillary Invoice data
+1 ; Input: FBDODINV - DoD Invoice number to use for selection
+2 ; Output: VistA invoices for the selected DoD invoice number are
+3 ; added to the temporary global
+4 ; Called From: COMPILE
+5 ;
+6 NEW DATA,IDTIEN,PATIEN,SVCIEN,VENIEN,VNAME
+7 SET PATIEN=""
+8 ; Patient IEN
FOR
Begin DoDot:1
+9 SET PATIEN=$ORDER(^FBAAC("DODI",FBDODINV,PATIEN))
+10 if PATIEN=""
QUIT
+11 SET VENIEN=""
+12 ; Vendor IEN
FOR
Begin DoDot:2
+13 SET VENIEN=$ORDER(^FBAAC("DODI",FBDODINV,PATIEN,VENIEN))
+14 if VENIEN=""
QUIT
+15 ; Vendor Name
SET VNAME=$PIECE($GET(^FBAAV(VENIEN,0)),U,1)
+16 SET IDTIEN=""
+17 ; Initial Service Date IEN
FOR
Begin DoDot:3
+18 SET IDTIEN=$ORDER(^FBAAC("DODI",FBDODINV,PATIEN,VENIEN,IDTIEN))
+19 if IDTIEN=""
QUIT
+20 SET SVCIEN=""
+21 ; Service Provided IEN
FOR
Begin DoDot:4
+22 SET SVCIEN=$ORDER(^FBAAC("DODI",FBDODINV,PATIEN,VENIEN,IDTIEN,SVCIEN))
+23 if SVCIEN=""
QUIT
+24 ;
+25 ; Store the row data for the invoice into the temporary global
+26 DO ROWDATAO(VNAME,PATIEN,VENIEN,IDTIEN,SVCIEN)
End DoDot:4
if SVCIEN=""
QUIT
End DoDot:3
if IDTIEN=""
QUIT
End DoDot:2
if VENIEN=""
QUIT
End DoDot:1
if PATIEN=""
QUIT
+27 QUIT
+28 ;
ROWDATAO(VNAME,PATIEN,VENIEN,IDTIEN,SVCIEN) ;
+1 ; Retrieves the information needed to display the VistA invoice row for an
+2 ; outpatient invoice or an Inpatient Ancillary invoice.
+3 ; Input: VNAME - Vendor Name of the Invoice
+4 ; PATIEN - Patient IEN
+5 ; VENIEN - Vendor IEN of the invoice
+6 ; IDTIEN - Internal Initial Treatment Date IEN
+7 ; SVCIEN - Invoice IEN
+8 ; ^TMP("FAAIAR1",$J) - Current temporary file
+9 ; Output: ^TMP("FAAIAR1",$J) - Updated with VistA Invoice data
+10 ; Called From: COMPOUT
+11 ;
+12 NEW DATA,INV0,INV2,INV3,INVNUM,TYPE,XX
+13 ; Outpatient Invoice 0 Node
SET INV0=$GET(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,0))
+14 ; Outpatient Invoice 2 Node
SET INV2=$GET(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,2))
+15 ; Outpatient Invoice 3 Node
SET INV3=$GET(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,3))
+16 ; VistA Invoice #
SET INVNUM=$PIECE(INV0,U,16)
+17 ; Fee Program ptr
SET ITYPE=+$PIECE(INV0,U,9)
+18 ; 0 - Outpatient, 1: Inpatient Ancillary
SET ITYPE=$SELECT(ITYPE=2:0,1:1)
+19 SET TYPE=$SELECT('ITYPE:"OUT",1:"ANC")
+20 ; Void/Purge/Cancel flags
SET DATA=$$GETTYPEO(PATIEN,VENIEN,IDTIEN,SVCIEN,INV0,INV2)
+21 ; Date Paid
SET $PIECE(DATA,U,2)=$PIECE(INV0,U,14)
+22 ; Amount Claimed
SET $PIECE(DATA,U,3)=$PIECE(INV0,U,2)
+23 ; Amount Paid
SET $PIECE(DATA,U,4)=$PIECE(INV0,U,3)
+24 ; Amount Adjusted
SET $PIECE(DATA,U,5)=$PIECE(INV0,U,4)
+25 SET XX=IDTIEN_"-"_SVCIEN
+26 ; VistA invoice data for the invoice
SET ^TMP("FBAAIAR1",$JOB,VNAME,TYPE,INVNUM,XX)=DATA
+27 ; Gather totals for invoice
DO TOTS(VNAME,TYPE,INVNUM,DATA)
+28 QUIT
+29 ;
GETTYPEO(PATIEN,VENIEN,IDTIEN,SVCIEN,INV0,INV2) ; Determines if the invoice has been
+1 ; cancelled, rejected, purged or voided or some combination
+2 ; Input: PATIEN - Patient IEN
+3 ; VENIEN - Vendor IEN
+4 ; IDTIEN - Initial Treatment Date IEN
+5 ; SVCIEN - Service Provided IEN
+6 ; INV0 - 0 node of the outpatient invoice
+7 ; INV2 - 2 node of the outpatient invoice
+8 ; Returns: V - Voided
+9 ; C - Cancelled
+10 ; R - Rejected
+11 ; P - Purged
+12 ; "" - Otherwise
+13 ; or any combination of C/V/R/P
+14 ; Called From: ROWDATAO
+15 NEW VAL
+16 SET VAL=""
+17 ; Rejected
if $DATA(^FBAAC(PATIEN,1,VENIEN,1,IDTIEN,1,SVCIEN,"FBREJC"))
SET VAL="R"
+18 ; Purged
if $DATA(^FBAAC(PATIEN,"PURGE",VENIEN,0))
SET VAL=VAL_"P"
+19 ; Cancelled
if $PIECE(INV2,U,4)'=""
SET VAL=VAL_"C"
+20 ; Voided
if $PIECE(INV0,U,21)'=""
SET VAL=VAL_"V"
+21 QUIT VAL
+22 ;
COMPIN(FBDODINV) ; Compile Inpatient Invoice data
+1 ; Input: FBDODINV - DoD Invoice number to use for selection
+2 ; ^TMP("FAAIAR1",$J) - Current temporary file
+3 ; Output: ^TMP("FAAIAR1",$J) - Updated with VistA Invoice data
+4 ; Called From: COMPILE
+5 ;
+6 NEW DATA,INIEN,INVNUM,INV0,INV2,INV5,ITYPE,VNAME,XX
+7 SET INIEN=""
+8 ; Inpatient Invoice by DoD Invoice #
FOR
Begin DoDot:1
+9 SET INIEN=$ORDER(^FBAAI("DODI",FBDODINV,INIEN))
+10 if INIEN=""
QUIT
+11 SET INV0=$GET(^FBAAI(INIEN,0))
+12 SET INV2=$GET(^FBAAI(INIEN,2))
+13 SET INV5=$GET(^FBAAI(INIEN,5))
+14 ; Vendor IEN
SET XX=+$PIECE(INV0,U,3)
+15 ; Vendor Name
SET VNAME=$PIECE($GET(^FBAAV(XX,0)),U,1)
+16 ; VistA Invoice #
SET INVNUM=$PIECE(INV0,U,1)
+17 ; Type of Record
SET DATA=$$GETTYPEI(INIEN,INV0,INV2)
+18 ; Date Paid
SET $PIECE(DATA,U,2)=$PIECE(INV2,U,1)
+19 ; Amount Claimed
SET $PIECE(DATA,U,3)=$PIECE(INV0,U,8)
+20 ; Amount Paid
SET $PIECE(DATA,U,4)=$PIECE(INV0,U,9)
+21 ; Amount Adjusted
SET $PIECE(DATA,U,5)=$PIECE(INV0,U,10)
+22 ; VistA invoice data for invoice
SET ^TMP("FBAAIAR1",$JOB,VNAME,"INP",INVNUM,0)=DATA
+23 ; Gather totals for invoice
DO TOTS(VNAME,"INP",INVNUM,DATA)
End DoDot:1
if INIEN=""
QUIT
+24 QUIT
+25 ;
GETTYPEI(INVIEN,INV0,INV2) ; Determines if the inpatient invoice has been
+1 ; cancelled, rejected or voided or some combination
+2 ; Input: INVIEN - IEN of the inpatient invoice
+3 ; INV0 - 0 node of the inpatient invoice
+4 ; INV2 - 2 node of the inpatient invoice
+5 ; INV5 - 5 node of the inpatient invoice
+6 ; Returns: V - Voided
+7 ; C - Cancelled
+8 ; R - Rejected
+9 ; "" - Otherwise
+10 ; or any combination of C/V/R
+11 ; Called From: COMPIN
+12 NEW VAL
+13 SET VAL=""
+14 ; Rejected
if $DATA(^FBAAI(INVIEN,"FBREJ"))
SET VAL="R"
+15 ; Cancelled
if $PIECE(INV2,U,5)'=""
SET VAL=VAL_"C"
+16 ; Voided
if $PIECE(INV0,U,14)'=""
SET VAL=VAL_"V"
+17 QUIT VAL
+18 ;
COMPRX(FBDODINV) ; Compile Pharmacy invoice data
+1 ; Input: FBDODINV - DoD Invoice number to use for selection
+2 ; ^TMP("FAAIAR1",$J) - Current temporary file
+3 ; Output: ^TMP("FAAIAR1",$J) - Updated with VistA Invoice data
+4 ; Called From: COMPILE
+5 ;
+6 NEW AMTA,AMTC,AMTP,DATA,DATEP,INVNUM,INV0,INV2,ITYPE,ITYPE2
+7 NEW PHIEN,RXIEN,RXINV,VNAME,XX
+8 SET PHIEN=""
SET DATEP=""
SET ITYPE2=""
+9 ; Pharmacy Invoice by DoD Invoice #
FOR
Begin DoDot:1
+10 SET PHIEN=$ORDER(^FBAA(162.1,"DODI",FBDODINV,PHIEN))
+11 if PHIEN=""
QUIT
+12 ; Init amount tots for invoice
SET (AMTA,AMTC,AMTP)=0
+13 ; Invoice level data
SET RXINV=$GET(^FBAA(162.1,PHIEN,0))
+14 ; Vendor IEN
SET XX=+$PIECE(RXINV,U,4)
+15 ; Vendor name
SET VNAME=$PIECE($GET(^FBAAV(XX,0)),U,1)
+16 ; VistA Invoice #
SET INVNUM=$PIECE(RXINV,U,1)
+17 SET RXIEN=""
+18 ; Prescription level
FOR
Begin DoDot:2
+19 SET RXIEN=$ORDER(^FBAA(162.1,"DODI",FBDODINV,PHIEN,RXIEN))
+20 if RXIEN=""
QUIT
+21 ; Prescription 0 Node
SET INV0=$GET(^FBAA(162.1,PHIEN,"RX",RXIEN,0))
+22 ; Prescription 2 Node
SET INV2=$GET(^FBAA(162.1,PHIEN,"RX",RXIEN,2))
+23 ; Type of Pharmacy Record
DO GETTYPEP(PHIEN,RXIEN,INV2,.ITYPE2)
+24 ; Date Paid
SET XX=$PIECE(INV2,U,8)
+25 ; Find the lowest date paid
SET DATEP=$SELECT(DATEP="":XX,XX<DATEP:XX,1:DATEP)
+26 ; Amount Claimed
SET AMTC=AMTC+$PIECE(INV0,U,4)
+27 ; Amount Paid
SET AMTP=AMTP+$PIECE(INV0,U,16)
+28 ; Amount Adjusted
SET AMTA=AMTA+$PIECE(INV0,U,7)
End DoDot:2
if RXIEN=""
QUIT
+29 ; Pharmacy Invoice Void/Cancel/Reject
SET DATA=ITYPE2
+30 ; Lowest date paid
SET $PIECE(DATA,U,2)=DATEP
+31 ; Total Amount claimed for Invoice
SET $PIECE(DATA,U,3)=AMTC
+32 ; Total Amount paid for Invoice
SET $PIECE(DATA,U,4)=AMTP
+33 ; Total Amount adjusted for Invoice
SET $PIECE(DATA,U,5)=AMTA
+34 ; VistA invoice data for invoice
SET ^TMP("FBAAIAR1",$JOB,VNAME,"RX",INVNUM,0)=DATA
+35 ; Gather totals for DoD invoice#
DO TOTS(VNAME,"RX",INVNUM,DATA)
End DoDot:1
if PHIEN=""
QUIT
+36 QUIT
+37 ;
GETTYPEP(PHIEN,RXIEN,INV2,ITYPE) ; Determines if the pharmacy invoice has any
+1 ; cancelled, rejected or voided prescriptions.
+2 ; Input: PHIEN - IEN of the pharmacy invoice
+3 ; RXIEN - Prescription IEN
+4 ; INV2 - 2 node of the pharmacy prescription invoice
+5 ; ITYPE - Current value for the pharmacy invoice
+6 ; Output: ITYPE - Updated value for the pharmacy invoice
+7 ; Called From: COMPRX
+8 ; Rejected
IF $DATA(^FBAA(162.1,PHIEN,"RX",RXIEN,"FBREJ"))
Begin DoDot:1
+9 SET ITYPE=$SELECT(ITYPE'["R":ITYPE_"R",1:ITYPE)
End DoDot:1
+10 ; Cancelled
IF $PIECE(INV2,U,11)'=""
Begin DoDot:1
+11 SET ITYPE=$SELECT(ITYPE'["C":ITYPE_"C",1:ITYPE)
End DoDot:1
QUIT
+12 ; Voided
IF $PIECE(INV2,U,3)'=""
Begin DoDot:1
+13 SET ITYPE=$SELECT(ITYPE'["V":ITYPE_"V",1:ITYPE)
End DoDot:1
QUIT
+14 QUIT
+15 ;
TOTS(VNAME,TYPE,INVNUM,DATA) ; Gather totals and other data for all invoices for
+1 ; the specified DoD invoice#. Update the scratch global with information
+2 ; Input: VNAME - Vendor Name
+3 ; TYPE - "OUT" - Outpatient Invoice
+4 ; "ANC" - Inpatient Ancillary Invoice
+5 ; "INP" - Inpatient Invoice
+6 ; "RX" - Pharmacy Invoice
+7 ; INVNUM - VistA Invoice Number
+8 ; DATA - ^TMP("FBAAIAR1",$J,VNAME,TYPE,INVNUM)
+9 ; ^TMP("FBAAIAR1",$J,VNAME) - Current DoD Invoice Vendor totals
+10 ; ^TMP("FBAAIAR1",$J,VNAME,TYPE) - Current Type totals
+11 ; Output: ^TMP("FBAAIAR1",$J,VNAME) - Updated DoD Invoice Vendor totals
+12 ; ^TMP("FBAAIAR1",$J,VNAME,TYPE) - Updated Type totals
+13 ; Called From: COMPIN, COMPOUT, COMPRX
+14 ;
+15 NEW CURTOT
+16 ; Current DoD Invoice Vendor totals
SET CURTOT=$GET(^TMP("FBAAIAR1",$JOB,VNAME))
+17 ; New Claimed Total
SET $PIECE(CURTOT,U,1)=$PIECE(DATA,U,3)+$PIECE(CURTOT,U,1)
+18 ; New Paid Total
SET $PIECE(CURTOT,U,2)=$PIECE(DATA,U,4)+$PIECE(CURTOT,U,2)
+19 ; New Adjustment Total
SET $PIECE(CURTOT,U,3)=$PIECE(DATA,U,5)+$PIECE(CURTOT,U,3)
+20 ; New Invoice count
SET $PIECE(CURTOT,U,4)=$PIECE(CURTOT,U,4)+1
+21 SET ^TMP("FBAAIAR1",$JOB,VNAME)=CURTOT
+22 ; Current DoD Invoice Vendor totals by type
SET CURTOT=$GET(^TMP("FBAAIAR1",$JOB,VNAME,TYPE))
+23 ; New Claimed Total
SET $PIECE(CURTOT,U,1)=$PIECE(DATA,U,3)+$PIECE(CURTOT,U,1)
+24 ; New Paid Total
SET $PIECE(CURTOT,U,2)=$PIECE(DATA,U,4)+$PIECE(CURTOT,U,2)
+25 ; New Adjustment Total
SET $PIECE(CURTOT,U,3)=$PIECE(DATA,U,5)+$PIECE(CURTOT,U,3)
+26 ; New Invoice count by type
SET $PIECE(CURTOT,U,4)=$PIECE(CURTOT,U,4)+1
+27 SET ^TMP("FBAAIAR1",$JOB,VNAME,TYPE)=CURTOT
+28 QUIT
+29 ;
