FBAAIARA ;ALB/ESG - Fee IPAC Vendor DoD Invoice (Summary) Report Print ;1/16/2014
;;3.5;FEE BASIS;**123**;JAN 30, 1995;Build 51
;;Per VA Directive 6402, this routine should not be modified.
;
; Scratch global built by FBAAIAR.
; ^TMP("FBAAIAR",$J,VENDOR NAME, DOD INVOICE#) =
; [1] vendor ien
; [2] vendor external ID#
; [3] date finalized (date that made this record eligible for report)
; [4] total amount claimed
; [5] total amount paid
; [6] total adjustment amount
; [7] Fee Invoice#
; [8] Fee Invoice# "+" flag if additional values exist
; [9] Batch#
; [10] Batch# "+" flag if additional values exist
; [11] Obligation#
; [12] Obligation# "+" flag if additional values exist
; [13] date paid
; [14] date paid "+" flag if additional values exist
; [15] date paid "*" flag is not all lines have a date paid value
; [16] check number
; [17] check number "+" flag if additional values exist
; [18] check number "*" flag if not all lines have a check#
; [19] total disbursed amount
;
; ^TMP("FBAAIAR",$J,VENDOR NAME) =
; [1] total number of DoD invoices for vendor
; [4] total amount claimed for vendor
; [5] total amount paid for vendor
; [6] total adjustment amount for vendor
; [19] total disbursed amount for vendor
;
Q
;
PRINT ; entry point for printing the report
; Variables assumed to exist from FBAAIAR: FBIAVEN, FBIABEG, FBIAEND, FBIATYPE, FBIAEXCEL
;
N CRT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FBDODINV,FBIASTOP,FBVENAME,ITSTR,PAGE,RPTG,RPTT,SEPLINE,X,Y
S CRT=$S(IOST["C-":1,1:0)
I FBIAEXCEL S IOSL=999999 ; long screen length for Excel output
S PAGE=0,FBIASTOP=0,$P(SEPLINE,"-",131)="",ITSTR=$$ITSTR(.FBIATYPE)
I '$D(^TMP("FBAAIAR",$J)) D HDR W !!?5,"No data found for this report." G PX
I $G(ZTSTOP) D HDR W !!?5,"This report was halted during compilation by TaskManager Request." G PX
;
I FBIAEXCEL D HDR I FBIASTOP G PRINTX ; for Excel CSV, display the header line first before looping
;
S FBVENAME="" F S FBVENAME=$O(^TMP("FBAAIAR",$J,FBVENAME)) Q:FBVENAME=""!FBIASTOP D
. K RPTG
. I 'FBIAEXCEL D HDR Q:FBIASTOP ; page break with each new vendor (not for Excel output)
. S FBDODINV="" F S FBDODINV=$O(^TMP("FBAAIAR",$J,FBVENAME,FBDODINV)) Q:FBDODINV=""!FBIASTOP D
.. S RPTG=$G(^TMP("FBAAIAR",$J,FBVENAME,FBDODINV))
.. ;
.. I FBIAEXCEL D EXCELN(FBVENAME,FBDODINV,RPTG) Q ; for Excel output, print a CSV format record
.. ;
.. I $Y+4>IOSL D HDR Q:FBIASTOP ; check for page break
.. W !,$$LJ^XLFSTR(FBDODINV,22) ; DoD invoice#
.. W $$RJ^XLFSTR("$"_$FN($P(RPTG,U,4),"",2),13) ; total amount claimed
.. W $$RJ^XLFSTR("$"_$FN($P(RPTG,U,5),"",2),13) ; total amount paid
.. W $$RJ^XLFSTR("$"_$FN($P(RPTG,U,6),"",2),13) ; total adjustment amount
.. W ?64,$$LJ^XLFSTR($P(RPTG,U,7)_$S($P(RPTG,U,8):"+",1:""),10) ; VA fee invoice#
.. W ?76,$$LJ^XLFSTR($P(RPTG,U,9)_$S($P(RPTG,U,10):"+",1:""),6) ; batch#
.. W ?84,$$LJ^XLFSTR($P(RPTG,U,11)_$S($P(RPTG,U,12):"+",1:""),7) ; obligation#
.. W ?93,$$LJ^XLFSTR($$FMTE^XLFDT($P(RPTG,U,13),"2DZ")_$S($P(RPTG,U,14):"+",1:"")_$S($P(RPTG,U,15):"*",1:""),10) ; dt paid
.. W ?105,$$LJ^XLFSTR($P(RPTG,U,16)_$S($P(RPTG,U,17):"+",1:"")_$S($P(RPTG,U,18):"*",1:""),10) ; check#
.. W $$RJ^XLFSTR("$"_$FN($P(RPTG,U,19),"",2),13) ; total amount disbursed
.. Q
. ;
. Q:FBIASTOP!FBIAEXCEL
. ;
. S RPTT=$G(^TMP("FBAAIAR",$J,FBVENAME)) ; totals for vendor
. ;
. ; display dollar totals for vendor
. I $Y+5>IOSL D HDR Q:FBIASTOP ; check for page break
. W !?24,"----------- ----------- -----------",?117,"-----------"
. W !?1,"$Totals for Vendor "
. W $$RJ^XLFSTR("$"_$FN($P(RPTT,U,4),"",2),13) ; total amount claimed
. W $$RJ^XLFSTR("$"_$FN($P(RPTT,U,5),"",2),13) ; total amount paid
. W $$RJ^XLFSTR("$"_$FN($P(RPTT,U,6),"",2),13) ; total adjustment amount
. W ?115,$$RJ^XLFSTR("$"_$FN($P(RPTT,U,19),"",2),13) ; total amount disbursed
. ;
. ; display total number of DoD invoices for vendor
. I $Y+5>IOSL D HDR Q:FBIASTOP ; check for page break
. W !!,"Total Number of DoD Invoices for Vendor: ",$P(RPTT,U,1)
. Q
;
I FBIASTOP G PRINTX ; get out right away if stop flag is set
;
I $Y+5>IOSL D HDR I FBIASTOP G PRINTX
W !!?5,"*** End of Report ***"
;
PX ;
I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
PRINTX ;
Q
;
EXCELN(FBVENAME,FBDODINV,RPTG) ; output one Excel line
; FBVENAME - vendor name
; FBDODINV - DoD invoice#
; RPTG - scratch global data string
N FBZ
S FBZ=$$CSV("",FBVENAME) ; vendor name
S FBZ=$$CSV(FBZ,$P(RPTG,U,2)) ; vendor ID#
S FBZ=$$CSV(FBZ,FBDODINV) ; DoD invoice#
S FBZ=$$CSV(FBZ,$FN($P(RPTG,U,4),"",2)) ; total amount claimed
S FBZ=$$CSV(FBZ,$FN($P(RPTG,U,5),"",2)) ; total amount paid
S FBZ=$$CSV(FBZ,$FN($P(RPTG,U,6),"",2)) ; total adjustment amount
S FBZ=$$CSV(FBZ,$P(RPTG,U,7)_$S($P(RPTG,U,8):"+",1:"")) ; VA fee invoice#
S FBZ=$$CSV(FBZ,$P(RPTG,U,9)_$S($P(RPTG,U,10):"+",1:"")) ; batch#
S FBZ=$$CSV(FBZ,$P(RPTG,U,11)_$S($P(RPTG,U,12):"+",1:"")) ; obligation#
S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,13),"2DZ")_$S($P(RPTG,U,14):"+",1:"")_$S($P(RPTG,U,15):"*",1:"")) ; date paid
S FBZ=$$CSV(FBZ,$P(RPTG,U,16)_$S($P(RPTG,U,17):"+",1:"")_$S($P(RPTG,U,18):"*",1:"")) ; check#
S FBZ=$$CSV(FBZ,$FN($P(RPTG,U,19),"",2)) ; total amount disbursed
W !,FBZ
Q
;
HDR ; report header
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,VENID,X,Y,Z
;
; Do an end of page reader call if page# exists and device is the screen
I PAGE,CRT S DIR(0)="E" D ^DIR K DIR I 'Y S FBIASTOP=1 G HDRX
;
; If screen output or page# exists, do a form feed
I PAGE!CRT W @IOF
;
; First printer/file page - do a left margin reset
I 'PAGE,'CRT W $C(13)
;
S PAGE=PAGE+1 ; increment page#
;
; For Excel CSV format, display the column headers only
I FBIAEXCEL D EXCELHD G HDRX
;
; Display the report headers
W "IPAC Vendor DoD Invoice Report"
W ?44,"For Date Range ",$$FMTE^XLFDT(FBIABEG,"5DZ")," - ",$$FMTE^XLFDT(FBIAEND,"5DZ")
W ?96,$$FMTE^XLFDT($$NOW^XLFDT),?120,"Page: ",PAGE
W !?3,"Selected Invoice Types: ",ITSTR
;
; display vendor name and ID if these things are known
I $G(FBVENAME)'="" D
. W !?14,"Vendor Name: ",FBVENAME
. S VENID=$P($G(RPTG),U,2)
. I VENID="" S Z=$O(^TMP("FBAAIAR",$J,FBVENAME,"")) I Z'="" S VENID=$P($G(^TMP("FBAAIAR",$J,FBVENAME,Z)),U,2)
. I VENID'="" W " (ID# ",VENID,")"
. Q
;
; now display the column headers
W !?26,"Total Amt",?39,"Total Amt",?52,"Total Amt",?64,"Fee Basis",?119,"Total Amt"
W !,"DoD Invoice Number",?28,"Claimed",?44,"Paid",?53,"Adjusted",?64,"Invoice#",?76,"Batch#",?84,"Oblig#",?93,"Date Paid",?105,"Check#",?119,"Disbursed"
W !,SEPLINE
;
; check for a TaskManager stop request
I $D(ZTQUEUED),$$S^%ZTLOAD() D G HDRX
. S (ZTSTOP,FBIASTOP)=1
. W !!!?5,"*** Report Halted by TaskManager Request ***"
. Q
HDRX ;
Q
;
EXCELHD ; print an Excel CSV header record (only 1 Excel CSV header should print for the whole report)
N FBH
S FBH=$$CSV("","Vendor Name")
S FBH=$$CSV(FBH,"Vendor ID")
S FBH=$$CSV(FBH,"DoD Invoice#")
S FBH=$$CSV(FBH,"Total Amount Claimed")
S FBH=$$CSV(FBH,"Total Amount Paid")
S FBH=$$CSV(FBH,"Total Adjustment Amount")
S FBH=$$CSV(FBH,"Fee Basis Invoice#")
S FBH=$$CSV(FBH,"Batch Number")
S FBH=$$CSV(FBH,"Obligation Number")
S FBH=$$CSV(FBH,"Date Paid")
S FBH=$$CSV(FBH,"Check Number")
S FBH=$$CSV(FBH,"Total Amount Disbursed")
W FBH
Q
;
CSV(STRING,DATA) ; build the Excel data string for CSV format
S DATA=$C(34)_$TR(DATA,$C(34),$C(39))_$C(34)
S STRING=$S(STRING="":DATA,1:STRING_","_DATA)
Q STRING
;
ITSTR(FBIATYPE) ; convert array of selected invoice types into a string for the report header
;
N ITSTR,ITX,TXT
S ITSTR=""
I $D(FBIATYPE("OUT")),$D(FBIATYPE("RX")),$D(FBIATYPE("INP")),$D(FBIATYPE("ANC")) S ITSTR="ALL" G ITSTRX
;
F ITX="OUT","RX","INP","ANC" I $D(FBIATYPE(ITX)) D
. S TXT=$S(ITX="OUT":"Outpatient",ITX="RX":"Pharmacy",ITX="INP":"Civil Hospital",ITX="ANC":"Civil Hospital Ancillary",1:"")
. S ITSTR=$S(ITSTR="":TXT,1:ITSTR_", "_TXT)
. Q
ITSTRX ;
Q ITSTR
;
COMPRX ; compile Pharmacy data (moved to this routine for space reasons)
;
N BCH,DATA,FBDODINV,FBDT,FBIA,FBINVN,FBJ,FBK,FBRXINV,FBVEN,FBVENAME,FBVENID,FBY0,FBY2,FBY6,FBYREJ
; 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
... 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 $D(^TMP("FBAAIAR",$J,FBVENAME,FBDODINV)) Q ; DoD invoice# data already exists
.... I $P(FBY2,U,11) Q ; cancelled
.... I $P(FBY2,U,3)'="" Q ; voided
.... I $P(FBYREJ,U,1)'="" Q ; rejected
.... ;
.... S DATA=FBVEN_U_FBVENID_U_FBDT
.... S $P(DATA,U,7)=FBINVN ; fee invoice number
.... S $P(DATA,U,9)=$P($G(^FBAA(161.7,BCH,0)),U,1) ; external batch#
.... S $P(DATA,U,11)=$P($G(^FBAA(161.7,BCH,0)),U,2) ; obligation# from the batch file
.... S $P(DATA,U,13)=$P(FBY2,U,8) ; Date Paid
.... S $P(DATA,U,16)=$P(FBY2,U,10) ; check number
.... S ^TMP("FBAAIAR",$J,FBVENAME,FBDODINV)=DATA ; store new data for this DoD invoice#
.... D GET^FBAAIAR(FBVENAME,FBDODINV) ; gather totals for DoD invoice#
.... Q
... Q
.. Q
. Q
COMPRXX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAIARA 10991 printed Sep 23, 2025@19:31:42 Page 2
FBAAIARA ;ALB/ESG - Fee IPAC Vendor DoD Invoice (Summary) Report Print ;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 ; Scratch global built by FBAAIAR.
+5 ; ^TMP("FBAAIAR",$J,VENDOR NAME, DOD INVOICE#) =
+6 ; [1] vendor ien
+7 ; [2] vendor external ID#
+8 ; [3] date finalized (date that made this record eligible for report)
+9 ; [4] total amount claimed
+10 ; [5] total amount paid
+11 ; [6] total adjustment amount
+12 ; [7] Fee Invoice#
+13 ; [8] Fee Invoice# "+" flag if additional values exist
+14 ; [9] Batch#
+15 ; [10] Batch# "+" flag if additional values exist
+16 ; [11] Obligation#
+17 ; [12] Obligation# "+" flag if additional values exist
+18 ; [13] date paid
+19 ; [14] date paid "+" flag if additional values exist
+20 ; [15] date paid "*" flag is not all lines have a date paid value
+21 ; [16] check number
+22 ; [17] check number "+" flag if additional values exist
+23 ; [18] check number "*" flag if not all lines have a check#
+24 ; [19] total disbursed amount
+25 ;
+26 ; ^TMP("FBAAIAR",$J,VENDOR NAME) =
+27 ; [1] total number of DoD invoices for vendor
+28 ; [4] total amount claimed for vendor
+29 ; [5] total amount paid for vendor
+30 ; [6] total adjustment amount for vendor
+31 ; [19] total disbursed amount for vendor
+32 ;
+33 QUIT
+34 ;
PRINT ; entry point for printing the report
+1 ; Variables assumed to exist from FBAAIAR: FBIAVEN, FBIABEG, FBIAEND, FBIATYPE, FBIAEXCEL
+2 ;
+3 NEW CRT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FBDODINV,FBIASTOP,FBVENAME,ITSTR,PAGE,RPTG,RPTT,SEPLINE,X,Y
+4 SET CRT=$SELECT(IOST["C-":1,1:0)
+5 ; long screen length for Excel output
IF FBIAEXCEL
SET IOSL=999999
+6 SET PAGE=0
SET FBIASTOP=0
SET $PIECE(SEPLINE,"-",131)=""
SET ITSTR=$$ITSTR(.FBIATYPE)
+7 IF '$DATA(^TMP("FBAAIAR",$JOB))
DO HDR
WRITE !!?5,"No data found for this report."
GOTO PX
+8 IF $GET(ZTSTOP)
DO HDR
WRITE !!?5,"This report was halted during compilation by TaskManager Request."
GOTO PX
+9 ;
+10 ; for Excel CSV, display the header line first before looping
IF FBIAEXCEL
DO HDR
IF FBIASTOP
GOTO PRINTX
+11 ;
+12 SET FBVENAME=""
FOR
SET FBVENAME=$ORDER(^TMP("FBAAIAR",$JOB,FBVENAME))
if FBVENAME=""!FBIASTOP
QUIT
Begin DoDot:1
+13 KILL RPTG
+14 ; page break with each new vendor (not for Excel output)
IF 'FBIAEXCEL
DO HDR
if FBIASTOP
QUIT
+15 SET FBDODINV=""
FOR
SET FBDODINV=$ORDER(^TMP("FBAAIAR",$JOB,FBVENAME,FBDODINV))
if FBDODINV=""!FBIASTOP
QUIT
Begin DoDot:2
+16 SET RPTG=$GET(^TMP("FBAAIAR",$JOB,FBVENAME,FBDODINV))
+17 ;
+18 ; for Excel output, print a CSV format record
IF FBIAEXCEL
DO EXCELN(FBVENAME,FBDODINV,RPTG)
QUIT
+19 ;
+20 ; check for page break
IF $Y+4>IOSL
DO HDR
if FBIASTOP
QUIT
+21 ; DoD invoice#
WRITE !,$$LJ^XLFSTR(FBDODINV,22)
+22 ; total amount claimed
WRITE $$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTG,U,4),"",2),13)
+23 ; total amount paid
WRITE $$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTG,U,5),"",2),13)
+24 ; total adjustment amount
WRITE $$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTG,U,6),"",2),13)
+25 ; VA fee invoice#
WRITE ?64,$$LJ^XLFSTR($PIECE(RPTG,U,7)_$SELECT($PIECE(RPTG,U,8):"+",1:""),10)
+26 ; batch#
WRITE ?76,$$LJ^XLFSTR($PIECE(RPTG,U,9)_$SELECT($PIECE(RPTG,U,10):"+",1:""),6)
+27 ; obligation#
WRITE ?84,$$LJ^XLFSTR($PIECE(RPTG,U,11)_$SELECT($PIECE(RPTG,U,12):"+",1:""),7)
+28 ; dt paid
WRITE ?93,$$LJ^XLFSTR($$FMTE^XLFDT($PIECE(RPTG,U,13),"2DZ")_$SELECT($PIECE(RPTG,U,14):"+",1:"")_$SELECT($PIECE(RPTG,U,15):"*",1:""),10)
+29 ; check#
WRITE ?105,$$LJ^XLFSTR($PIECE(RPTG,U,16)_$SELECT($PIECE(RPTG,U,17):"+",1:"")_$SELECT($PIECE(RPTG,U,18):"*",1:""),10)
+30 ; total amount disbursed
WRITE $$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTG,U,19),"",2),13)
+31 QUIT
End DoDot:2
+32 ;
+33 if FBIASTOP!FBIAEXCEL
QUIT
+34 ;
+35 ; totals for vendor
SET RPTT=$GET(^TMP("FBAAIAR",$JOB,FBVENAME))
+36 ;
+37 ; display dollar totals for vendor
+38 ; check for page break
IF $Y+5>IOSL
DO HDR
if FBIASTOP
QUIT
+39 WRITE !?24,"----------- ----------- -----------",?117,"-----------"
+40 WRITE !?1,"$Totals for Vendor "
+41 ; total amount claimed
WRITE $$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTT,U,4),"",2),13)
+42 ; total amount paid
WRITE $$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTT,U,5),"",2),13)
+43 ; total adjustment amount
WRITE $$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTT,U,6),"",2),13)
+44 ; total amount disbursed
WRITE ?115,$$RJ^XLFSTR("$"_$FNUMBER($PIECE(RPTT,U,19),"",2),13)
+45 ;
+46 ; display total number of DoD invoices for vendor
+47 ; check for page break
IF $Y+5>IOSL
DO HDR
if FBIASTOP
QUIT
+48 WRITE !!,"Total Number of DoD Invoices for Vendor: ",$PIECE(RPTT,U,1)
+49 QUIT
End DoDot:1
+50 ;
+51 ; get out right away if stop flag is set
IF FBIASTOP
GOTO PRINTX
+52 ;
+53 IF $Y+5>IOSL
DO HDR
IF FBIASTOP
GOTO PRINTX
+54 WRITE !!?5,"*** End of Report ***"
+55 ;
PX ;
+1 IF CRT
IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
DO ^DIR
KILL DIR
PRINTX ;
+1 QUIT
+2 ;
EXCELN(FBVENAME,FBDODINV,RPTG) ; output one Excel line
+1 ; FBVENAME - vendor name
+2 ; FBDODINV - DoD invoice#
+3 ; RPTG - scratch global data string
+4 NEW FBZ
+5 ; vendor name
SET FBZ=$$CSV("",FBVENAME)
+6 ; vendor ID#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,2))
+7 ; DoD invoice#
SET FBZ=$$CSV(FBZ,FBDODINV)
+8 ; total amount claimed
SET FBZ=$$CSV(FBZ,$FNUMBER($PIECE(RPTG,U,4),"",2))
+9 ; total amount paid
SET FBZ=$$CSV(FBZ,$FNUMBER($PIECE(RPTG,U,5),"",2))
+10 ; total adjustment amount
SET FBZ=$$CSV(FBZ,$FNUMBER($PIECE(RPTG,U,6),"",2))
+11 ; VA fee invoice#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,7)_$SELECT($PIECE(RPTG,U,8):"+",1:""))
+12 ; batch#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,9)_$SELECT($PIECE(RPTG,U,10):"+",1:""))
+13 ; obligation#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,11)_$SELECT($PIECE(RPTG,U,12):"+",1:""))
+14 ; date paid
SET FBZ=$$CSV(FBZ,$$FMTE^XLFDT($PIECE(RPTG,U,13),"2DZ")_$SELECT($PIECE(RPTG,U,14):"+",1:"")_$SELECT($PIECE(RPTG,U,15):"*",1:""))
+15 ; check#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,16)_$SELECT($PIECE(RPTG,U,17):"+",1:"")_$SELECT($PIECE(RPTG,U,18):"*",1:""))
+16 ; total amount disbursed
SET FBZ=$$CSV(FBZ,$FNUMBER($PIECE(RPTG,U,19),"",2))
+17 WRITE !,FBZ
+18 QUIT
+19 ;
HDR ; report header
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,VENID,X,Y,Z
+3 ;
+4 ; Do an end of page reader call if page# exists and device is the screen
+5 IF PAGE
IF CRT
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBIASTOP=1
GOTO HDRX
+6 ;
+7 ; If screen output or page# exists, do a form feed
+8 IF PAGE!CRT
WRITE @IOF
+9 ;
+10 ; First printer/file page - do a left margin reset
+11 IF 'PAGE
IF 'CRT
WRITE $CHAR(13)
+12 ;
+13 ; increment page#
SET PAGE=PAGE+1
+14 ;
+15 ; For Excel CSV format, display the column headers only
+16 IF FBIAEXCEL
DO EXCELHD
GOTO HDRX
+17 ;
+18 ; Display the report headers
+19 WRITE "IPAC Vendor DoD Invoice Report"
+20 WRITE ?44,"For Date Range ",$$FMTE^XLFDT(FBIABEG,"5DZ")," - ",$$FMTE^XLFDT(FBIAEND,"5DZ")
+21 WRITE ?96,$$FMTE^XLFDT($$NOW^XLFDT),?120,"Page: ",PAGE
+22 WRITE !?3,"Selected Invoice Types: ",ITSTR
+23 ;
+24 ; display vendor name and ID if these things are known
+25 IF $GET(FBVENAME)'=""
Begin DoDot:1
+26 WRITE !?14,"Vendor Name: ",FBVENAME
+27 SET VENID=$PIECE($GET(RPTG),U,2)
+28 IF VENID=""
SET Z=$ORDER(^TMP("FBAAIAR",$JOB,FBVENAME,""))
IF Z'=""
SET VENID=$PIECE($GET(^TMP("FBAAIAR",$JOB,FBVENAME,Z)),U,2)
+29 IF VENID'=""
WRITE " (ID# ",VENID,")"
+30 QUIT
End DoDot:1
+31 ;
+32 ; now display the column headers
+33 WRITE !?26,"Total Amt",?39,"Total Amt",?52,"Total Amt",?64,"Fee Basis",?119,"Total Amt"
+34 WRITE !,"DoD Invoice Number",?28,"Claimed",?44,"Paid",?53,"Adjusted",?64,"Invoice#",?76,"Batch#",?84,"Oblig#",?93,"Date Paid",?105,"Check#",?119,"Disbursed"
+35 WRITE !,SEPLINE
+36 ;
+37 ; check for a TaskManager stop request
+38 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
Begin DoDot:1
+39 SET (ZTSTOP,FBIASTOP)=1
+40 WRITE !!!?5,"*** Report Halted by TaskManager Request ***"
+41 QUIT
End DoDot:1
GOTO HDRX
HDRX ;
+1 QUIT
+2 ;
EXCELHD ; print an Excel CSV header record (only 1 Excel CSV header should print for the whole report)
+1 NEW FBH
+2 SET FBH=$$CSV("","Vendor Name")
+3 SET FBH=$$CSV(FBH,"Vendor ID")
+4 SET FBH=$$CSV(FBH,"DoD Invoice#")
+5 SET FBH=$$CSV(FBH,"Total Amount Claimed")
+6 SET FBH=$$CSV(FBH,"Total Amount Paid")
+7 SET FBH=$$CSV(FBH,"Total Adjustment Amount")
+8 SET FBH=$$CSV(FBH,"Fee Basis Invoice#")
+9 SET FBH=$$CSV(FBH,"Batch Number")
+10 SET FBH=$$CSV(FBH,"Obligation Number")
+11 SET FBH=$$CSV(FBH,"Date Paid")
+12 SET FBH=$$CSV(FBH,"Check Number")
+13 SET FBH=$$CSV(FBH,"Total Amount Disbursed")
+14 WRITE FBH
+15 QUIT
+16 ;
CSV(STRING,DATA) ; build the Excel data string for CSV format
+1 SET DATA=$CHAR(34)_$TRANSLATE(DATA,$CHAR(34),$CHAR(39))_$CHAR(34)
+2 SET STRING=$SELECT(STRING="":DATA,1:STRING_","_DATA)
+3 QUIT STRING
+4 ;
ITSTR(FBIATYPE) ; convert array of selected invoice types into a string for the report header
+1 ;
+2 NEW ITSTR,ITX,TXT
+3 SET ITSTR=""
+4 IF $DATA(FBIATYPE("OUT"))
IF $DATA(FBIATYPE("RX"))
IF $DATA(FBIATYPE("INP"))
IF $DATA(FBIATYPE("ANC"))
SET ITSTR="ALL"
GOTO ITSTRX
+5 ;
+6 FOR ITX="OUT","RX","INP","ANC"
IF $DATA(FBIATYPE(ITX))
Begin DoDot:1
+7 SET TXT=$SELECT(ITX="OUT":"Outpatient",ITX="RX":"Pharmacy",ITX="INP":"Civil Hospital",ITX="ANC":"Civil Hospital Ancillary",1:"")
+8 SET ITSTR=$SELECT(ITSTR="":TXT,1:ITSTR_", "_TXT)
+9 QUIT
End DoDot:1
ITSTRX ;
+1 QUIT ITSTR
+2 ;
COMPRX ; compile Pharmacy data (moved to this routine for space reasons)
+1 ;
+2 NEW BCH,DATA,FBDODINV,FBDT,FBIA,FBINVN,FBJ,FBK,FBRXINV,FBVEN,FBVENAME,FBVENID,FBY0,FBY2,FBY6,FBYREJ
+3 ; loop thru batch file by date finalized for specified date range
+4 SET FBDT=$ORDER(^FBAA(161.7,"AF",FBIABEG),-1)
+5 FOR
SET FBDT=$ORDER(^FBAA(161.7,"AF",FBDT))
if 'FBDT!(FBDT>FBIAEND)
QUIT
Begin DoDot:1
+6 SET BCH=0
FOR
SET BCH=$ORDER(^FBAA(161.7,"AF",FBDT,BCH))
if 'BCH
QUIT
Begin DoDot:2
+7 ;
+8 ; loop thru the pharmacy (B5) payments for a batch
+9 SET FBJ=0
FOR
SET FBJ=$ORDER(^FBAA(162.1,"AE",BCH,FBJ))
if 'FBJ
QUIT
Begin DoDot:3
+10 ; rx invoice level data
SET FBRXINV=$GET(^FBAA(162.1,FBJ,0))
+11 ; vendor ien
SET FBVEN=+$PIECE(FBRXINV,U,4)
+12 ; vendor is not among the selected vendors for report
IF '$DATA(FBIAVEN(FBVEN))
QUIT
+13 ; ipac ptr
SET FBIA=+$PIECE(FBRXINV,U,23)
+14 ; ipac ptr must exist to be included on this report
IF 'FBIA
QUIT
+15 ; Rx invoice#
SET FBINVN=$PIECE(FBRXINV,U,1)
+16 ; vendor name
SET FBVENAME=$PIECE($GET(^FBAAV(FBVEN,0)),U,1)
+17 ; vendor external ID
SET FBVENID=$PIECE($GET(^FBAAV(FBVEN,0)),U,2)
+18 ;
+19 SET FBK=0
FOR
SET FBK=$ORDER(^FBAA(162.1,"AE",BCH,FBJ,FBK))
if 'FBK
QUIT
Begin DoDot:4
+20 SET FBY0=$GET(^FBAA(162.1,FBJ,"RX",FBK,0))
+21 SET FBY2=$GET(^FBAA(162.1,FBJ,"RX",FBK,2))
+22 SET FBY6=$GET(^FBAA(162.1,FBJ,"RX",FBK,6))
+23 SET FBYREJ=$GET(^FBAA(162.1,FBJ,"RX",FBK,"FBREJ"))
+24 ; DoD invoice# must be present
SET FBDODINV=$PIECE(FBY6,U,1)
IF FBDODINV=""
QUIT
+25 ; DoD invoice# data already exists
IF $DATA(^TMP("FBAAIAR",$JOB,FBVENAME,FBDODINV))
QUIT
+26 ; cancelled
IF $PIECE(FBY2,U,11)
QUIT
+27 ; voided
IF $PIECE(FBY2,U,3)'=""
QUIT
+28 ; rejected
IF $PIECE(FBYREJ,U,1)'=""
QUIT
+29 ;
+30 SET DATA=FBVEN_U_FBVENID_U_FBDT
+31 ; fee invoice number
SET $PIECE(DATA,U,7)=FBINVN
+32 ; external batch#
SET $PIECE(DATA,U,9)=$PIECE($GET(^FBAA(161.7,BCH,0)),U,1)
+33 ; obligation# from the batch file
SET $PIECE(DATA,U,11)=$PIECE($GET(^FBAA(161.7,BCH,0)),U,2)
+34 ; Date Paid
SET $PIECE(DATA,U,13)=$PIECE(FBY2,U,8)
+35 ; check number
SET $PIECE(DATA,U,16)=$PIECE(FBY2,U,10)
+36 ; store new data for this DoD invoice#
SET ^TMP("FBAAIAR",$JOB,FBVENAME,FBDODINV)=DATA
+37 ; gather totals for DoD invoice#
DO GET^FBAAIAR(FBVENAME,FBDODINV)
+38 QUIT
End DoDot:4
+39 QUIT
End DoDot:3
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
COMPRXX ;
+1 QUIT
+2 ;
