FBAAIARD ;ALB/ESG - Fee IPAC Vendor Payment Report (Detail) Print ;2/17/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 FBAAIARB (Detail report)
; ^TMP("FBAAIARB",$J,Vendor_Name,Payment_Type,DoD_Invoice#,Date_Of_Service,Pt_Name,IENS) = DATA
;
Q
;
PRINT ; entry point for printing the report
; Variables assumed to exist from FBAAIARB: FBIAVEN, FBIABEG, FBIAEND, FBIATYPE, FBIAEXCEL, FBIAADJ, FBIAIGNORE
;
N CRT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FBDODINV,FBIASTOP,FBVENAME,FBZDOS,FBZIENS,FBZPTNM,FBZTYPE,ITSTR,PAGE,RPTG,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,"-",133)="",ITSTR=$$ITSTR^FBAAIARA(.FBIATYPE)
;
I '$D(^TMP("FBAAIARB",$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 output, print the Header row first of all
;
S FBVENAME="" F S FBVENAME=$O(^TMP("FBAAIARB",$J,FBVENAME)) Q:FBVENAME=""!FBIASTOP D
. S FBZTYPE="" F S FBZTYPE=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE)) Q:FBZTYPE=""!FBIASTOP D
.. K RPTG
.. I 'FBIAEXCEL D HDR Q:FBIASTOP ; page break on type since the column headings change (n/a for Excel)
.. ;
.. S FBDODINV="" F S FBDODINV=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV)) Q:FBDODINV=""!FBIASTOP D
... S FBZDOS=0 F S FBZDOS=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS)) Q:'FBZDOS!FBIASTOP D
.... S FBZPTNM="" F S FBZPTNM=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM)) Q:FBZPTNM=""!FBIASTOP D
..... S FBZIENS="" F S FBZIENS=$O(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS)) Q:FBZIENS=""!FBIASTOP D
...... D RPTLN
...... Q
..... Q
.... Q
... Q
.. Q
. 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
;
RPTLN ; display one payment line item detail
S RPTG=$G(^TMP("FBAAIARB",$J,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS))
;
; for Excel output, print a CSV line and get out
I FBIAEXCEL D EXCELN(RPTG) Q
;
I $Y+5>IOSL D HDR Q:FBIASTOP ; check for page break
W !,$$LJ^XLFSTR(FBDODINV,20) ; DoD invoice#
W ?21,$$LJ^XLFSTR(FBZPTNM,"16T") ; patient name
W ?38,$E($P(RPTG,U,4),6,10) ; patient ID - last4 (10th digit for "P"seudo SSN)
W ?44,$$FMTE^XLFDT(FBZDOS,"2Z") ; date of service
;
I +FBZTYPE=1!(+FBZTYPE=4) W ?54,$P(RPTG,U,5),?61,$P(RPTG,U,7) ; outpat/ancil procedure code/revenue code
I +FBZTYPE=2,$P(RPTG,U,8) W ?54,$$FMTE^XLFDT($P(RPTG,U,8),"2Z") ; inpatient discharge date
I +FBZTYPE=3 W ?54,$P(RPTG,U,12) ; pharmacy prescription number
;
W ?64,$$RJ^XLFSTR($FN($P(RPTG,U,14),"",2),10) ; amount claimed
W $$RJ^XLFSTR($FN($P(RPTG,U,15),"",2),10) ; amount paid
W $$RJ^XLFSTR($FN($P(RPTG,U,16),"",2),10) ; amount adjusted #1
W ?95,$E($P(RPTG,U,17),1,6) ; adjustment group code-reason code #1
W ?103,$$FMTE^XLFDT($P(RPTG,U,23),"2Z") ; date paid
W ?113,$E($P(RPTG,U,24),1,8) ; check number
W ?122,$$RJ^XLFSTR($FN($P(RPTG,U,25),"",2),"10T") ; disbursed amount
;
; line 2 data
W !?3,$P(RPTG,U,20) ; Fee invoice#
W ?14,$P(RPTG,U,21) ; batch#
W ?21,$P(RPTG,U,22) ; obligation#
W ?29,$S($P(RPTG,U,27):"**VOIDED**",1:"") ; voided payment indicator
;
I +FBZTYPE'=2,$P(RPTG,U,28)'="" W ?40,"**REJECTED**" ; rejected payment indicator (not inpat)
I +FBZTYPE=2 W ?46,$P(RPTG,U,10) ; inpatient admitting diagnosis code
I +FBZTYPE=1!(+FBZTYPE=4) W ?54,$P(RPTG,U,6) ; outpat/ancil list of proc modifiers
I +FBZTYPE=3 W ?54,$E($P(RPTG,U,13),1,29) ; pharmacy drug name
I +FBZTYPE=2,$P(RPTG,U,28)'="" W ?61,"**REJECTED**" ; rejected payment indicator (inpat)
;
I $P(RPTG,U,18) W ?84,$$RJ^XLFSTR($FN($P(RPTG,U,18),"",2),10) ; amount adjusted #2
W ?95,$E($P(RPTG,U,19),1,6) ; adjustment group code-reason code #2
;
I $P(RPTG,U,26) W ?106,"**CANCELLED ",$$FMTE^XLFDT($P(RPTG,U,26),"2Z"),"**"
;
I +FBZTYPE'=2 Q ; no more data for anything except inpatient
;
; Inpatient display of up to 25 diagnosis/poa and 25 procedure codes
I $P(RPTG,U,9)'="" D DIAGDISP($P(RPTG,U,9)) Q:FBIASTOP
I $P(RPTG,U,11)'="" D PROCDISP($P(RPTG,U,11)) Q:FBIASTOP
;
RPTLNX ;
Q
;
DIAGDISP(Z) ; For inpatient, display diagnosis codes and POA codes
N DELIM,P,DXP
I $Y+4>IOSL D HDR Q:FBIASTOP ; check for page break
S DELIM=", "
W !?3,"DX(POA): "
F P=1:1:$L(Z,DELIM) D
. S DXP=$P(Z,DELIM,P) Q:DXP=""
. I $X+$L(DXP)+4>IOM W !?12
. W DXP
. I $P(Z,DELIM,P+1)'="" W DELIM
. Q
Q
;
PROCDISP(Z) ; For inpatient, display procedure codes
N DELIM,P,PRC
I $Y+4>IOSL D HDR Q:FBIASTOP ; check for page break
S DELIM=", "
W !?6,"PROC: "
F P=1:1:$L(Z,DELIM) D
. S PRC=$P(Z,DELIM,P) Q:PRC=""
. I $X+$L(PRC)+4>IOM W !?12
. W PRC
. I $P(Z,DELIM,P+1)'="" W DELIM
. Q
Q
;
HDR ; report header
;
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,HTYP,VENID,X,Y
;
; 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
;
S HTYP=$G(FBZTYPE) ; current type being displayed on this page (may not exist)
;
; Display the report headers
W "IPAC Vendor Payment 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
I FBIAADJ W ?102,"**Suspended Payments Only**"
;
I $G(FBVENAME)'="" D
. W !?3,"Vendor Name: ",FBVENAME
. S VENID=$P($G(RPTG),U,2)
. I VENID="" S VENID=$P($G(^TMP("FBAAIARB",$J,FBVENAME)),U,1)
. I VENID'="" W " (ID# ",VENID,")"
. I HTYP="" Q
. W ?81,"Invoice Type: "
. I +HTYP=1!(+HTYP=4) W "Outpatient/Civil Hospital Ancillary"
. I +HTYP=2 W "Civil Hospital Inpatient"
. I +HTYP=3 W "Pharmacy"
. Q
;
; now display the column headers
W !,"DoD Invoice Number",?21,"Patient Name",?38,"SSN"
I +HTYP=1!(+HTYP=4) W ?44,"Svc Dt Proc Rev"
I +HTYP=2 W ?44,"Admit Dt Disch Dt"
I +HTYP=3 W ?44,"Fill Dt Rx#"
W ?66,"Claimed",?79,"Paid",?90,"Adj Reason",?103,"Dt Paid",?113,"Check#",?123,"Disbursed"
W !?3,"Fee Inv#",?14,"Bch#",?21,"Oblig#"
I +HTYP=1!(+HTYP=4) W ?54,"Modifiers"
I +HTYP=2 W ?46,"Adm Dx"
I +HTYP=3 W ?54,"Drug Name"
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,"Payment Type")
S FBH=$$CSV(FBH,"DoD Invoice#")
S FBH=$$CSV(FBH,"Date of Service/Fill Date/Admit Date")
S FBH=$$CSV(FBH,"Patient Name")
S FBH=$$CSV(FBH,"Date Finalized")
S FBH=$$CSV(FBH,"Patient SSN")
S FBH=$$CSV(FBH,"CPT Procedure Code")
S FBH=$$CSV(FBH,"CPT Procedure Modifiers")
S FBH=$$CSV(FBH,"Revenue Code")
S FBH=$$CSV(FBH,"Discharge Date")
S FBH=$$CSV(FBH,"Diagnosis/POA Codes")
S FBH=$$CSV(FBH,"Admitting Diagnosis")
S FBH=$$CSV(FBH,"Procedure Codes Inpatient")
S FBH=$$CSV(FBH,"Prescription#")
S FBH=$$CSV(FBH,"Drug Name")
S FBH=$$CSV(FBH,"Amount Claimed")
S FBH=$$CSV(FBH,"Amount Paid")
S FBH=$$CSV(FBH,"Adjustment Amount #1")
S FBH=$$CSV(FBH,"Adjustment Reason #1")
S FBH=$$CSV(FBH,"Adjustment Amount #2")
S FBH=$$CSV(FBH,"Adjustment Reason #2")
S FBH=$$CSV(FBH,"Fee Invoice#")
S FBH=$$CSV(FBH,"Batch#")
S FBH=$$CSV(FBH,"Obligation#")
S FBH=$$CSV(FBH,"Date Paid")
S FBH=$$CSV(FBH,"Check#")
S FBH=$$CSV(FBH,"Disbursed Amount")
S FBH=$$CSV(FBH,"Cancellation Date")
S FBH=$$CSV(FBH,"Voided Payment Flag")
S FBH=$$CSV(FBH,"Reject Status")
W FBH
Q
;
EXCELN(RPTG) ; write a line of CSV data
N FBZ,X,Y
S X=FBZTYPE
S Y=$S(+X=1:"Outpatient",+X=2:"Inpatient",+X=3:"Pharmacy",1:"Ancillary")
;
S FBZ=$$CSV("",FBVENAME) ; vendor name
S FBZ=$$CSV(FBZ,$P(RPTG,U,2)) ; vendor ID
S FBZ=$$CSV(FBZ,Y) ; invoice/payment type
S FBZ=$$CSV(FBZ,FBDODINV) ; DoD invoice#
S FBZ=$$CSV(FBZ,$$FMTE^XLFDT(FBZDOS,"2Z")) ; date of service/fill date/admit date
S FBZ=$$CSV(FBZ,FBZPTNM) ; pt name
S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,3),"2Z")) ; Date line item finalized within the date range of this report
S FBZ=$$CSV(FBZ,$E($P(RPTG,U,4),6,10)) ; pt ssn last 4
S FBZ=$$CSV(FBZ,$P(RPTG,U,5)) ; cpt procedure code
S FBZ=$$CSV(FBZ,$P(RPTG,U,6)) ; CPT modifiers
S FBZ=$$CSV(FBZ,$P(RPTG,U,7)) ; revenue code
S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,8),"2Z")) ; discharge date
S FBZ=$$CSV(FBZ,$P(RPTG,U,9)) ; list of Diag/poa codes
S FBZ=$$CSV(FBZ,$P(RPTG,U,10)) ; admitting dx
S FBZ=$$CSV(FBZ,$P(RPTG,U,11)) ; list of inpatient procedure codes
S FBZ=$$CSV(FBZ,$P(RPTG,U,12)) ; prescription#
S FBZ=$$CSV(FBZ,$P(RPTG,U,13)) ; drug name
S FBZ=$$CSV(FBZ,$P(RPTG,U,14)) ; amt claimed
S FBZ=$$CSV(FBZ,$P(RPTG,U,15)) ; amt paid
S FBZ=$$CSV(FBZ,$P(RPTG,U,16)) ; adjustment amt#1
S FBZ=$$CSV(FBZ,$P(RPTG,U,17)) ; adjustment reason#1
S FBZ=$$CSV(FBZ,$P(RPTG,U,18)) ; adjustment amt#2
S FBZ=$$CSV(FBZ,$P(RPTG,U,19)) ; adjustment reason#2
S FBZ=$$CSV(FBZ,$P(RPTG,U,20)) ; fee basis invoice#
S FBZ=$$CSV(FBZ,$P(RPTG,U,21)) ; batch#
S FBZ=$$CSV(FBZ,$P(RPTG,U,22)) ; obligation#
S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,23),"2Z")) ; date paid
S FBZ=$$CSV(FBZ,$P(RPTG,U,24)) ; check#
S FBZ=$$CSV(FBZ,$P(RPTG,U,25)) ; disbursed amt
S FBZ=$$CSV(FBZ,$$FMTE^XLFDT($P(RPTG,U,26),"2Z")) ; cancellation date
S FBZ=$$CSV(FBZ,$S($P(RPTG,U,27):"VOID",1:"")) ; voided payment flag
S FBZ=$$CSV(FBZ,$P(RPTG,U,28)) ; reject status
W !,FBZ
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAIARD 11701 printed Sep 23, 2025@19:31:45 Page 2
FBAAIARD ;ALB/ESG - Fee IPAC Vendor Payment Report (Detail) Print ;2/17/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 FBAAIARB (Detail report)
+5 ; ^TMP("FBAAIARB",$J,Vendor_Name,Payment_Type,DoD_Invoice#,Date_Of_Service,Pt_Name,IENS) = DATA
+6 ;
+7 QUIT
+8 ;
PRINT ; entry point for printing the report
+1 ; Variables assumed to exist from FBAAIARB: FBIAVEN, FBIABEG, FBIAEND, FBIATYPE, FBIAEXCEL, FBIAADJ, FBIAIGNORE
+2 ;
+3 NEW CRT,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FBDODINV,FBIASTOP,FBVENAME,FBZDOS,FBZIENS,FBZPTNM,FBZTYPE,ITSTR,PAGE,RPTG,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,"-",133)=""
SET ITSTR=$$ITSTR^FBAAIARA(.FBIATYPE)
+7 ;
+8 IF '$DATA(^TMP("FBAAIARB",$JOB))
DO HDR
WRITE !!?5,"No data found for this report."
GOTO PX
+9 IF $GET(ZTSTOP)
DO HDR
WRITE !!?5,"This report was halted during compilation by TaskManager Request."
GOTO PX
+10 ;
+11 ; for Excel CSV output, print the Header row first of all
IF FBIAEXCEL
DO HDR
IF FBIASTOP
GOTO PRINTX
+12 ;
+13 SET FBVENAME=""
FOR
SET FBVENAME=$ORDER(^TMP("FBAAIARB",$JOB,FBVENAME))
if FBVENAME=""!FBIASTOP
QUIT
Begin DoDot:1
+14 SET FBZTYPE=""
FOR
SET FBZTYPE=$ORDER(^TMP("FBAAIARB",$JOB,FBVENAME,FBZTYPE))
if FBZTYPE=""!FBIASTOP
QUIT
Begin DoDot:2
+15 KILL RPTG
+16 ; page break on type since the column headings change (n/a for Excel)
IF 'FBIAEXCEL
DO HDR
if FBIASTOP
QUIT
+17 ;
+18 SET FBDODINV=""
FOR
SET FBDODINV=$ORDER(^TMP("FBAAIARB",$JOB,FBVENAME,FBZTYPE,FBDODINV))
if FBDODINV=""!FBIASTOP
QUIT
Begin DoDot:3
+19 SET FBZDOS=0
FOR
SET FBZDOS=$ORDER(^TMP("FBAAIARB",$JOB,FBVENAME,FBZTYPE,FBDODINV,FBZDOS))
if 'FBZDOS!FBIASTOP
QUIT
Begin DoDot:4
+20 SET FBZPTNM=""
FOR
SET FBZPTNM=$ORDER(^TMP("FBAAIARB",$JOB,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM))
if FBZPTNM=""!FBIASTOP
QUIT
Begin DoDot:5
+21 SET FBZIENS=""
FOR
SET FBZIENS=$ORDER(^TMP("FBAAIARB",$JOB,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS))
if FBZIENS=""!FBIASTOP
QUIT
Begin DoDot:6
+22 DO RPTLN
+23 QUIT
End DoDot:6
+24 QUIT
End DoDot:5
+25 QUIT
End DoDot:4
+26 QUIT
End DoDot:3
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 ;
+30 ; get out right away if stop flag is set
IF FBIASTOP
GOTO PRINTX
+31 ;
+32 IF $Y+5>IOSL
DO HDR
IF FBIASTOP
GOTO PRINTX
+33 WRITE !!?5,"*** End of Report ***"
+34 ;
PX ;
+1 IF CRT
IF '$DATA(ZTQUEUED)
SET DIR(0)="E"
DO ^DIR
KILL DIR
PRINTX ;
+1 QUIT
+2 ;
RPTLN ; display one payment line item detail
+1 SET RPTG=$GET(^TMP("FBAAIARB",$JOB,FBVENAME,FBZTYPE,FBDODINV,FBZDOS,FBZPTNM,FBZIENS))
+2 ;
+3 ; for Excel output, print a CSV line and get out
+4 IF FBIAEXCEL
DO EXCELN(RPTG)
QUIT
+5 ;
+6 ; check for page break
IF $Y+5>IOSL
DO HDR
if FBIASTOP
QUIT
+7 ; DoD invoice#
WRITE !,$$LJ^XLFSTR(FBDODINV,20)
+8 ; patient name
WRITE ?21,$$LJ^XLFSTR(FBZPTNM,"16T")
+9 ; patient ID - last4 (10th digit for "P"seudo SSN)
WRITE ?38,$EXTRACT($PIECE(RPTG,U,4),6,10)
+10 ; date of service
WRITE ?44,$$FMTE^XLFDT(FBZDOS,"2Z")
+11 ;
+12 ; outpat/ancil procedure code/revenue code
IF +FBZTYPE=1!(+FBZTYPE=4)
WRITE ?54,$PIECE(RPTG,U,5),?61,$PIECE(RPTG,U,7)
+13 ; inpatient discharge date
IF +FBZTYPE=2
IF $PIECE(RPTG,U,8)
WRITE ?54,$$FMTE^XLFDT($PIECE(RPTG,U,8),"2Z")
+14 ; pharmacy prescription number
IF +FBZTYPE=3
WRITE ?54,$PIECE(RPTG,U,12)
+15 ;
+16 ; amount claimed
WRITE ?64,$$RJ^XLFSTR($FNUMBER($PIECE(RPTG,U,14),"",2),10)
+17 ; amount paid
WRITE $$RJ^XLFSTR($FNUMBER($PIECE(RPTG,U,15),"",2),10)
+18 ; amount adjusted #1
WRITE $$RJ^XLFSTR($FNUMBER($PIECE(RPTG,U,16),"",2),10)
+19 ; adjustment group code-reason code #1
WRITE ?95,$EXTRACT($PIECE(RPTG,U,17),1,6)
+20 ; date paid
WRITE ?103,$$FMTE^XLFDT($PIECE(RPTG,U,23),"2Z")
+21 ; check number
WRITE ?113,$EXTRACT($PIECE(RPTG,U,24),1,8)
+22 ; disbursed amount
WRITE ?122,$$RJ^XLFSTR($FNUMBER($PIECE(RPTG,U,25),"",2),"10T")
+23 ;
+24 ; line 2 data
+25 ; Fee invoice#
WRITE !?3,$PIECE(RPTG,U,20)
+26 ; batch#
WRITE ?14,$PIECE(RPTG,U,21)
+27 ; obligation#
WRITE ?21,$PIECE(RPTG,U,22)
+28 ; voided payment indicator
WRITE ?29,$SELECT($PIECE(RPTG,U,27):"**VOIDED**",1:"")
+29 ;
+30 ; rejected payment indicator (not inpat)
IF +FBZTYPE'=2
IF $PIECE(RPTG,U,28)'=""
WRITE ?40,"**REJECTED**"
+31 ; inpatient admitting diagnosis code
IF +FBZTYPE=2
WRITE ?46,$PIECE(RPTG,U,10)
+32 ; outpat/ancil list of proc modifiers
IF +FBZTYPE=1!(+FBZTYPE=4)
WRITE ?54,$PIECE(RPTG,U,6)
+33 ; pharmacy drug name
IF +FBZTYPE=3
WRITE ?54,$EXTRACT($PIECE(RPTG,U,13),1,29)
+34 ; rejected payment indicator (inpat)
IF +FBZTYPE=2
IF $PIECE(RPTG,U,28)'=""
WRITE ?61,"**REJECTED**"
+35 ;
+36 ; amount adjusted #2
IF $PIECE(RPTG,U,18)
WRITE ?84,$$RJ^XLFSTR($FNUMBER($PIECE(RPTG,U,18),"",2),10)
+37 ; adjustment group code-reason code #2
WRITE ?95,$EXTRACT($PIECE(RPTG,U,19),1,6)
+38 ;
+39 IF $PIECE(RPTG,U,26)
WRITE ?106,"**CANCELLED ",$$FMTE^XLFDT($PIECE(RPTG,U,26),"2Z"),"**"
+40 ;
+41 ; no more data for anything except inpatient
IF +FBZTYPE'=2
QUIT
+42 ;
+43 ; Inpatient display of up to 25 diagnosis/poa and 25 procedure codes
+44 IF $PIECE(RPTG,U,9)'=""
DO DIAGDISP($PIECE(RPTG,U,9))
if FBIASTOP
QUIT
+45 IF $PIECE(RPTG,U,11)'=""
DO PROCDISP($PIECE(RPTG,U,11))
if FBIASTOP
QUIT
+46 ;
RPTLNX ;
+1 QUIT
+2 ;
DIAGDISP(Z) ; For inpatient, display diagnosis codes and POA codes
+1 NEW DELIM,P,DXP
+2 ; check for page break
IF $Y+4>IOSL
DO HDR
if FBIASTOP
QUIT
+3 SET DELIM=", "
+4 WRITE !?3,"DX(POA): "
+5 FOR P=1:1:$LENGTH(Z,DELIM)
Begin DoDot:1
+6 SET DXP=$PIECE(Z,DELIM,P)
if DXP=""
QUIT
+7 IF $X+$LENGTH(DXP)+4>IOM
WRITE !?12
+8 WRITE DXP
+9 IF $PIECE(Z,DELIM,P+1)'=""
WRITE DELIM
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
PROCDISP(Z) ; For inpatient, display procedure codes
+1 NEW DELIM,P,PRC
+2 ; check for page break
IF $Y+4>IOSL
DO HDR
if FBIASTOP
QUIT
+3 SET DELIM=", "
+4 WRITE !?6,"PROC: "
+5 FOR P=1:1:$LENGTH(Z,DELIM)
Begin DoDot:1
+6 SET PRC=$PIECE(Z,DELIM,P)
if PRC=""
QUIT
+7 IF $X+$LENGTH(PRC)+4>IOM
WRITE !?12
+8 WRITE PRC
+9 IF $PIECE(Z,DELIM,P+1)'=""
WRITE DELIM
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
HDR ; report header
+1 ;
+2 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,HTYP,VENID,X,Y
+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 ; current type being displayed on this page (may not exist)
SET HTYP=$GET(FBZTYPE)
+19 ;
+20 ; Display the report headers
+21 WRITE "IPAC Vendor Payment Report"
+22 WRITE ?44,"For Date Range ",$$FMTE^XLFDT(FBIABEG,"5DZ")," - ",$$FMTE^XLFDT(FBIAEND,"5DZ")
+23 WRITE ?96,$$FMTE^XLFDT($$NOW^XLFDT),?120,"Page: ",PAGE
+24 WRITE !?3,"Selected Invoice Types: ",ITSTR
+25 IF FBIAADJ
WRITE ?102,"**Suspended Payments Only**"
+26 ;
+27 IF $GET(FBVENAME)'=""
Begin DoDot:1
+28 WRITE !?3,"Vendor Name: ",FBVENAME
+29 SET VENID=$PIECE($GET(RPTG),U,2)
+30 IF VENID=""
SET VENID=$PIECE($GET(^TMP("FBAAIARB",$JOB,FBVENAME)),U,1)
+31 IF VENID'=""
WRITE " (ID# ",VENID,")"
+32 IF HTYP=""
QUIT
+33 WRITE ?81,"Invoice Type: "
+34 IF +HTYP=1!(+HTYP=4)
WRITE "Outpatient/Civil Hospital Ancillary"
+35 IF +HTYP=2
WRITE "Civil Hospital Inpatient"
+36 IF +HTYP=3
WRITE "Pharmacy"
+37 QUIT
End DoDot:1
+38 ;
+39 ; now display the column headers
+40 WRITE !,"DoD Invoice Number",?21,"Patient Name",?38,"SSN"
+41 IF +HTYP=1!(+HTYP=4)
WRITE ?44,"Svc Dt Proc Rev"
+42 IF +HTYP=2
WRITE ?44,"Admit Dt Disch Dt"
+43 IF +HTYP=3
WRITE ?44,"Fill Dt Rx#"
+44 WRITE ?66,"Claimed",?79,"Paid",?90,"Adj Reason",?103,"Dt Paid",?113,"Check#",?123,"Disbursed"
+45 WRITE !?3,"Fee Inv#",?14,"Bch#",?21,"Oblig#"
+46 IF +HTYP=1!(+HTYP=4)
WRITE ?54,"Modifiers"
+47 IF +HTYP=2
WRITE ?46,"Adm Dx"
+48 IF +HTYP=3
WRITE ?54,"Drug Name"
+49 WRITE !,SEPLINE
+50 ;
+51 ; check for a TaskManager stop request
+52 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
Begin DoDot:1
+53 SET (ZTSTOP,FBIASTOP)=1
+54 WRITE !!!?5,"*** Report Halted by TaskManager Request ***"
+55 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,"Payment Type")
+5 SET FBH=$$CSV(FBH,"DoD Invoice#")
+6 SET FBH=$$CSV(FBH,"Date of Service/Fill Date/Admit Date")
+7 SET FBH=$$CSV(FBH,"Patient Name")
+8 SET FBH=$$CSV(FBH,"Date Finalized")
+9 SET FBH=$$CSV(FBH,"Patient SSN")
+10 SET FBH=$$CSV(FBH,"CPT Procedure Code")
+11 SET FBH=$$CSV(FBH,"CPT Procedure Modifiers")
+12 SET FBH=$$CSV(FBH,"Revenue Code")
+13 SET FBH=$$CSV(FBH,"Discharge Date")
+14 SET FBH=$$CSV(FBH,"Diagnosis/POA Codes")
+15 SET FBH=$$CSV(FBH,"Admitting Diagnosis")
+16 SET FBH=$$CSV(FBH,"Procedure Codes Inpatient")
+17 SET FBH=$$CSV(FBH,"Prescription#")
+18 SET FBH=$$CSV(FBH,"Drug Name")
+19 SET FBH=$$CSV(FBH,"Amount Claimed")
+20 SET FBH=$$CSV(FBH,"Amount Paid")
+21 SET FBH=$$CSV(FBH,"Adjustment Amount #1")
+22 SET FBH=$$CSV(FBH,"Adjustment Reason #1")
+23 SET FBH=$$CSV(FBH,"Adjustment Amount #2")
+24 SET FBH=$$CSV(FBH,"Adjustment Reason #2")
+25 SET FBH=$$CSV(FBH,"Fee Invoice#")
+26 SET FBH=$$CSV(FBH,"Batch#")
+27 SET FBH=$$CSV(FBH,"Obligation#")
+28 SET FBH=$$CSV(FBH,"Date Paid")
+29 SET FBH=$$CSV(FBH,"Check#")
+30 SET FBH=$$CSV(FBH,"Disbursed Amount")
+31 SET FBH=$$CSV(FBH,"Cancellation Date")
+32 SET FBH=$$CSV(FBH,"Voided Payment Flag")
+33 SET FBH=$$CSV(FBH,"Reject Status")
+34 WRITE FBH
+35 QUIT
+36 ;
EXCELN(RPTG) ; write a line of CSV data
+1 NEW FBZ,X,Y
+2 SET X=FBZTYPE
+3 SET Y=$SELECT(+X=1:"Outpatient",+X=2:"Inpatient",+X=3:"Pharmacy",1:"Ancillary")
+4 ;
+5 ; vendor name
SET FBZ=$$CSV("",FBVENAME)
+6 ; vendor ID
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,2))
+7 ; invoice/payment type
SET FBZ=$$CSV(FBZ,Y)
+8 ; DoD invoice#
SET FBZ=$$CSV(FBZ,FBDODINV)
+9 ; date of service/fill date/admit date
SET FBZ=$$CSV(FBZ,$$FMTE^XLFDT(FBZDOS,"2Z"))
+10 ; pt name
SET FBZ=$$CSV(FBZ,FBZPTNM)
+11 ; Date line item finalized within the date range of this report
SET FBZ=$$CSV(FBZ,$$FMTE^XLFDT($PIECE(RPTG,U,3),"2Z"))
+12 ; pt ssn last 4
SET FBZ=$$CSV(FBZ,$EXTRACT($PIECE(RPTG,U,4),6,10))
+13 ; cpt procedure code
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,5))
+14 ; CPT modifiers
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,6))
+15 ; revenue code
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,7))
+16 ; discharge date
SET FBZ=$$CSV(FBZ,$$FMTE^XLFDT($PIECE(RPTG,U,8),"2Z"))
+17 ; list of Diag/poa codes
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,9))
+18 ; admitting dx
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,10))
+19 ; list of inpatient procedure codes
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,11))
+20 ; prescription#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,12))
+21 ; drug name
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,13))
+22 ; amt claimed
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,14))
+23 ; amt paid
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,15))
+24 ; adjustment amt#1
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,16))
+25 ; adjustment reason#1
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,17))
+26 ; adjustment amt#2
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,18))
+27 ; adjustment reason#2
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,19))
+28 ; fee basis invoice#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,20))
+29 ; batch#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,21))
+30 ; obligation#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,22))
+31 ; date paid
SET FBZ=$$CSV(FBZ,$$FMTE^XLFDT($PIECE(RPTG,U,23),"2Z"))
+32 ; check#
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,24))
+33 ; disbursed amt
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,25))
+34 ; cancellation date
SET FBZ=$$CSV(FBZ,$$FMTE^XLFDT($PIECE(RPTG,U,26),"2Z"))
+35 ; voided payment flag
SET FBZ=$$CSV(FBZ,$SELECT($PIECE(RPTG,U,27):"VOID",1:""))
+36 ; reject status
SET FBZ=$$CSV(FBZ,$PIECE(RPTG,U,28))
+37 WRITE !,FBZ
+38 QUIT
+39 ;
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 ;
