FBCKDIS ;AISC/CMR-OUTPUT BY CHECK # ;7/NOV/2006
;;3.5;FEE BASIS;**4,61,101**;JAN 30, 1995;Build 2
;;Per VHA Directive 2004-038, this routine should not be modified.
;FBCN=Check Number FBPROG=Fee payment type
;FBPR is set if called from the phone menu. If this variable exists,
; the user will not be returned to the TOP to select another ck #.
TOP W ! S DIR(0)="FO^1:8",DIR("A")="Select Check Number" D ^DIR K DIR Q:Y=""!(Y="^") S FBCN=Y
I '$D(^FBAAC("ACK",FBCN)),('$D(^FBAAC("ACKT",FBCN))),('$D(^FBAAI("ACK",FBCN))),('$D(^FBAA(162.1,"ACK",FBCN))) W !!,*7,"There is no record of that check number." G TOP
S VAR="FBCN",VAL=FBCN,PGM="START^FBCKDIS" D ZIS^FBAAUTL G END:FBPOP
START S Q="-",$P(Q,"-",80)="-",QQ="=",$P(QQ,"=",80)="=",FBPG=1 K ^TMP($J,"FBCK")
N FBV,DFN D ^FBCKDIS1
U IO W:$E(IOST,1,2)["C-" @IOF
F FBPROG="OPT","CH","CNH","PHAR","TRAV" I $D(^TMP($J,"FBCK",FBPROG)) D PGCHK D Q:$G(FBAAOUT)
.S FBV=0 F S FBV=$O(^TMP($J,"FBCK",FBPROG,FBV)) Q:FBV']""!($G(FBAAOUT)) W:FBPROG'="TRAV" !!,"VENDOR: ",$$VNAME^FBNHEXP(FBV),?40," VENDOR ID: ",$$VID^FBNHEXP(FBV) D
..S DFN=0 F S DFN=$O(^TMP($J,"FBCK",FBPROG,FBV,DFN)) Q:'DFN!($G(FBAAOUT)) D:$Y+8>IOSL PGCHK Q:$G(FBAAOUT) W !!,"Patient: ",$$NAME^FBCHREQ2(DFN),?40,"Patient ID: ",$$SSNL4^FBAAUTL($$SSN^FBAAUTL(DFN)) D
...N FBAARC,FBADJLA,FBADJLR,FBC,FBFPPSC,FBFPPSL,FBSUSPA,FBX
...S FBCNT=0 F S FBCNT=$O(^TMP($J,"FBCK",FBPROG,FBV,DFN,FBCNT)) Q:'FBCNT!($G(FBAAOUT)) S FBDA=^(FBCNT) D @FBPROG,OUTPUT,CLEAN
END K FBCN,FBCNT,DFN,FBV,FBPROG,FBPG,DIRUT,DTOUT,DUOUT,Q,QQ,^TMP($J,"FBCK")
D CLOSE^FBAAUTL
I $G(FBAAOUT) K FBAAOUT Q
Q:$G(FBPR)]""!($G(ZTQUEUED))
W !! S DIR(0)="E" D ^DIR K DIR Q:'Y G TOP
OPT ;gather payment line item for outpatient
F I=1:1:4 S FB(I)=+$P(FBDA,U,I)
S FBA=^FBAAC(FB(1),1,FB(2),1,FB(3),1,FB(4),0),FBB=^(2),FBC=$G(^(3))
S FBDOS=+^FBAAC(FB(1),1,FB(2),1,FB(3),0)
S FBSRV=$$CPT^FBAAUTL4($P(FBA,U))
S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_FB(1)_",1,"_FB(2)_",1,"_FB(3)_",1,"_FB(4)_",""M"")","E")
S FBSRV=FBSRV_$S($G(FBMODLE)]"":"-"_FBMODLE,1:"")
S FBAMCL=$P(FBA,U,2),FBAMPD=$P(FBA,U,3)
S FBSUSP=$P(FBA,U,5) D SUSP^FBCKDIS1
S FBSUSPA=$FN($P(FBA,U,4),"",2)
S FBFPPSC=$P(FBC,U)
S FBFPPSL=$P(FBC,U,2)
S FBAARCE=$$GET1^DIQ(162.03,FB(4)_","_FB(3)_","_FB(2)_","_FB(1)_",",48)
S FBX=$$ADJLRA^FBAAFA(FB(4)_","_FB(3)_","_FB(2)_","_FB(1)_",")
S FBADJLR=$P(FBX,U)
S FBADJLA=$P(FBX,U,2)
S FBVP=$P(FBA,U,21),FBREIM=$P(FBA,U,20),FBBAT=$P(FBA,U,8),FBINV=$P(FBA,U,16)
D FBCKO^FBAACCB2(FB(1),FB(2),FB(3),FB(4))
Q
CH ;gather payment line item for ch
CNH ;gather payment line item for cnh
S FBA=^FBAAI(FBDA,0),FBB=^(2),FBC=$G(^(3)),FBDOS=$P(FBA,U,6)_"-"_$P(FBA,U,7),FBAMCL=$P(FBA,U,8),FBAMPD=$P(FBA,U,9),FBSUSP=$P(FBA,U,11) D SUSP^FBCKDIS1
S FBVP=$P(FBA,U,14),FBREIM=$P(FBA,U,13),FBBAT=$P(FBA,U,17),FBINV=+FBA
S FBSUSPA=$FN($P(FBA,U,10),"",2)
S FBFPPSC=$P(FBC,U)
S FBFPPSL=$P(FBC,U,2)
S FBX=$$ADJLRA^FBCHFA(FBDA_",")
S FBADJLR=$P(FBX,U)
S FBADJLA=$P(FBX,U,2)
D FBCKI^FBAACCB1(FBDA)
Q
PHAR ;gather payment line item for pharmacy
F I=1,2 S FB(I)=$P(FBDA,U,I)
S FBA=^FBAA(162.1,FB(1),"RX",FB(2),0),FBB=^(2),FBC=$G(^(3)),FBDOS=$P(FBA,U,3),FBSRV=$P(FBA,"^"),FBAMCL=$P(FBA,U,4),FBAMPD=$P(FBA,U,16),FBSUSP=$P(FBA,U,8) D SUSP^FBCKDIS1
S FBVP=$P(FBB,U,3),FBREIM=$P(FBA,U,20),FBBAT=$P($G(FBA),U,17),FBINV=+$G(^FBAA(162.1,FB(1),0))
S FBSUSPA=$FN($P(FBA,U,7),"",2)
S FBFPPSC=$P($G(^FBAA(162.1,FB(1),0)),U,13)
S FBFPPSL=$P(FBC,U)
S FBX=$$ADJLRA^FBRXFA(FB(2)_","_FB(1)_",")
S FBADJLR=$P(FBX,U)
S FBADJLA=$P(FBX,U,2)
D FBCKP^FBAACCB1(FB(1),FB(2))
Q
TRAV ;gather payment line item for travel
F I=1,2 S FB(I)=$P(FBDA,U,I)
S FBA=^FBAAC(FB(1),3,FB(2),0),FBDOS=+FBA,FBAMCL=$P(FBA,U,3),FBAMPD=FBAMCL,FBVP="",FBREIM="R",FBBAT=$P(FBA,U,2),FBINV=""
D FBCKT^FBAACCB0(FB(1),FB(2))
Q
CLEAN ;clean up variables
K I,FB,FBA,FBB,FBDOS,FBSRV,FBMOD,FBAMCL,FBAMPD,FBSUSP,FBVP,FBREIM,FBBAT,FBINV,FBDA,FBMODLE
Q
OUTPUT ;display line items for check number
I $Y+5>IOSL D PGCHK Q:$G(FBAAOUT)
W ! W:FBVP="VP" "#" W:FBREIM="R" "*" W:FBCAN]"" "+" D Q:$G(FBAAOUT)
. I FBPROG["C" D Q
. . W ?3,$$DATX^FBAAUTL($P(FBDOS,"-")),?15,$$DATX^FBAAUTL($P(FBDOS,"-",2)),?59,+$G(^FBAA(161.7,+FBBAT,0)),?68,FBINV
. . W !?3,$J($FN(FBAMCL,",",2),10),?15,$J($FN(FBAMPD,",",2),10)
. . ; write adjustment reasons, if null then write suspend code
. . W ?28,$S(FBADJLR]"":FBADJLR,1:FBSUSP)
. . ; write adjustment amounts, if null then write amount suspended
. . W ?38,$S(FBADJLA]"":FBADJLA,1:FBSUSPA)
. . I FBFPPSC]"" W !,?12,"FPPS Claim ID: ",FBFPPSC,?40,"FPPS Line Item: ",FBFPPSL
. I FBPROG="OPT" D Q
. . W ?3,$$DATX^FBAAUTL(FBDOS),?13,$P(FBSRV,","),?23,FBAARCE
. . W ?59,+$G(^FBAA(161.7,+FBBAT,0)),?68,FBINV
. . I $P(FBSRV,",",2)]"" D Q:$G(FBAAOUT)
. . . N FBI,FBMOD
. . . F FBI=2:1 S FBMOD=$P(FBSRV,",",FBI) Q:FBMOD="" D Q:$G(FBAAOUT)
. . . . I $Y+5>IOSL D PGCHK Q:$G(FBAAOUT) W !," (continued)"
. . . . W !,?18,"-",FBMOD
. . W !?3,$J($FN(FBAMCL,",",2),10),?15,$J($FN(FBAMPD,",",2),10)
. . ; write adjustment reasons, if null then write suspend code
. . W ?28,$S(FBADJLR]"":FBADJLR,1:FBSUSP)
. . ; write adjustment amounts, if null then write amount suspended
. . W ?38,$S(FBADJLA]"":FBADJLA,1:FBSUSPA)
. . I FBFPPSC]"" W !,?12,"FPPS Claim ID: ",FBFPPSC,?40,"FPPS Line Item: ",FBFPPSL
. I FBPROG="PHAR" D Q
. . W ?3,$$DATX^FBAAUTL(FBDOS),?13,FBSRV,?59,+$G(^FBAA(161.7,+FBBAT,0)),?68,FBINV
. . W !?3,$J($FN(FBAMCL,",",2),10),?15,$J($FN(FBAMPD,",",2),10)
. . ; write adjustment reasons, if null then write suspend code
. . W ?28,$S(FBADJLR]"":FBADJLR,1:FBSUSP)
. . ; write adjustment amounts, if null then write amount suspended
. . W ?38,$S(FBADJLA]"":FBADJLA,1:FBSUSPA)
. . I FBFPPSC]"" W !,?12,"FPPS Claim ID: ",FBFPPSC,?40,"FPPS Line Item: ",FBFPPSL
. W ?3,$$DATX^FBAAUTL(FBDOS) W:FBPROG'="TRAV" ?13,FBSRV W ?20,$J($FN(FBAMCL,",",2),10),?32,$J($FN(FBAMPD,",",2),10) W:FBPROG'="TRAV" ?47,FBSUSP W ?53,+$G(^FBAA(161.7,+FBBAT,0)),?65,FBINV
S A2=FBAMPD D PMNT^FBAACCB2 K A2
Q
HED W !?20,"PAYMENT HISTORY FOR CHECK # ",FBCN,!,?20,$E(Q,1,(28+$L(FBCN))),?70,"Page: ",FBPG
W !!,?22,"FEE PROGRAM: ",$S(FBPROG="OPT":"OUTPATIENT",FBPROG="CH":"CIVIL HOSPITAL",FBPROG="CNH":"COMMUNITY NURSING HOME",FBPROG="PHAR":"PHARMACY",FBPROG="TRAV":"TRAVEL",1:"")
W !?1,"('*' Reimbursement to Patient '#' Voided Payment '+' Cancellation Activity)"
I FBPROG["C" D Q
. W !?3,"From Date",?15,"To Date",?59,"Batch #",?68,"Invoice #"
. W !?3,"Amt Claimed",?17,"Amt Paid",?28,"Adj Code",?38,"Adj Amount"
. W !,QQ
I FBPROG="TRAV" W !?3,"Travel Dt",?21,"Amount",?33,"Amount",?50,"Batch",?62,"Invoice",!,?21,"Claimed",?34,"Paid",?50,"Number",?62,"Number",!,QQ Q
I FBPROG="OPT" D Q
. W !?3,"Svc Date",?13,"CPT-MOD",?23,"Rev.Code",?59,"Batch #",?68,"Invoice #"
. W !?3,"Amt Claimed",?17,"Amt Paid",?28,"Adj Code",?38,"Adj Amount"
. W !,QQ
I FBPROG="PHAR" D Q
. W !?3,"Fill Dt",?13,"RX #",?56,"Batch #",?68,"Invoice #"
. W !?3,"Amt Claimed",?17,"Amt Paid",?28,"Adj Code",?38,"Adj Amount"
. W !,QQ
Q
PGCHK I FBPG>1,($E(IOST,1,2)["C-") W !! S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
W:FBPG>1 @IOF D HED
S FBPG=FBPG+1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCKDIS 7258 printed Apr 09, 2024@21:01:26 Page 2
FBCKDIS ;AISC/CMR-OUTPUT BY CHECK # ;7/NOV/2006
+1 ;;3.5;FEE BASIS;**4,61,101**;JAN 30, 1995;Build 2
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;FBCN=Check Number FBPROG=Fee payment type
+4 ;FBPR is set if called from the phone menu. If this variable exists,
+5 ; the user will not be returned to the TOP to select another ck #.
TOP WRITE !
SET DIR(0)="FO^1:8"
SET DIR("A")="Select Check Number"
DO ^DIR
KILL DIR
if Y=""!(Y="^")
QUIT
SET FBCN=Y
+1 IF '$DATA(^FBAAC("ACK",FBCN))
IF ('$DATA(^FBAAC("ACKT",FBCN)))
IF ('$DATA(^FBAAI("ACK",FBCN)))
IF ('$DATA(^FBAA(162.1,"ACK",FBCN)))
WRITE !!,*7,"There is no record of that check number."
GOTO TOP
+2 SET VAR="FBCN"
SET VAL=FBCN
SET PGM="START^FBCKDIS"
DO ZIS^FBAAUTL
if FBPOP
GOTO END
START SET Q="-"
SET $PIECE(Q,"-",80)="-"
SET QQ="="
SET $PIECE(QQ,"=",80)="="
SET FBPG=1
KILL ^TMP($JOB,"FBCK")
+1 NEW FBV,DFN
DO ^FBCKDIS1
+2 USE IO
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+3 FOR FBPROG="OPT","CH","CNH","PHAR","TRAV"
IF $DATA(^TMP($JOB,"FBCK",FBPROG))
DO PGCHK
Begin DoDot:1
+4 SET FBV=0
FOR
SET FBV=$ORDER(^TMP($JOB,"FBCK",FBPROG,FBV))
if FBV']""!($GET(FBAAOUT))
QUIT
if FBPROG'="TRAV"
WRITE !!,"VENDOR: ",$$VNAME^FBNHEXP(FBV),?40," VENDOR ID: ",$$VID^FBNHEXP(FBV)
Begin DoDot:2
+5 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"FBCK",FBPROG,FBV,DFN))
if 'DFN!($GET(FBAAOUT))
QUIT
if $Y+8>IOSL
DO PGCHK
if $GET(FBAAOUT)
QUIT
WRITE !!,"Patient: ",$$NAME^FBCHREQ2(DFN),?40,"Patient ID: ",$$SSNL4^FBAAUTL($$SSN^FBAAUTL(DFN))
Begin DoDot:3
+6 NEW FBAARC,FBADJLA,FBADJLR,FBC,FBFPPSC,FBFPPSL,FBSUSPA,FBX
+7 SET FBCNT=0
FOR
SET FBCNT=$ORDER(^TMP($JOB,"FBCK",FBPROG,FBV,DFN,FBCNT))
if 'FBCNT!($GET(FBAAOUT))
QUIT
SET FBDA=^(FBCNT)
DO @FBPROG
DO OUTPUT
DO CLEAN
End DoDot:3
End DoDot:2
End DoDot:1
if $GET(FBAAOUT)
QUIT
END KILL FBCN,FBCNT,DFN,FBV,FBPROG,FBPG,DIRUT,DTOUT,DUOUT,Q,QQ,^TMP($JOB,"FBCK")
+1 DO CLOSE^FBAAUTL
+2 IF $GET(FBAAOUT)
KILL FBAAOUT
QUIT
+3 if $GET(FBPR)]""!($GET(ZTQUEUED))
QUIT
+4 WRITE !!
SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
QUIT
GOTO TOP
OPT ;gather payment line item for outpatient
+1 FOR I=1:1:4
SET FB(I)=+$PIECE(FBDA,U,I)
+2 SET FBA=^FBAAC(FB(1),1,FB(2),1,FB(3),1,FB(4),0)
SET FBB=^(2)
SET FBC=$GET(^(3))
+3 SET FBDOS=+^FBAAC(FB(1),1,FB(2),1,FB(3),0)
+4 SET FBSRV=$$CPT^FBAAUTL4($PIECE(FBA,U))
+5 SET FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_FB(1)_",1,"_FB(2)_",1,"_FB(3)_",1,"_FB(4)_",""M"")","E")
+6 SET FBSRV=FBSRV_$SELECT($GET(FBMODLE)]"":"-"_FBMODLE,1:"")
+7 SET FBAMCL=$PIECE(FBA,U,2)
SET FBAMPD=$PIECE(FBA,U,3)
+8 SET FBSUSP=$PIECE(FBA,U,5)
DO SUSP^FBCKDIS1
+9 SET FBSUSPA=$FNUMBER($PIECE(FBA,U,4),"",2)
+10 SET FBFPPSC=$PIECE(FBC,U)
+11 SET FBFPPSL=$PIECE(FBC,U,2)
+12 SET FBAARCE=$$GET1^DIQ(162.03,FB(4)_","_FB(3)_","_FB(2)_","_FB(1)_",",48)
+13 SET FBX=$$ADJLRA^FBAAFA(FB(4)_","_FB(3)_","_FB(2)_","_FB(1)_",")
+14 SET FBADJLR=$PIECE(FBX,U)
+15 SET FBADJLA=$PIECE(FBX,U,2)
+16 SET FBVP=$PIECE(FBA,U,21)
SET FBREIM=$PIECE(FBA,U,20)
SET FBBAT=$PIECE(FBA,U,8)
SET FBINV=$PIECE(FBA,U,16)
+17 DO FBCKO^FBAACCB2(FB(1),FB(2),FB(3),FB(4))
+18 QUIT
CH ;gather payment line item for ch
CNH ;gather payment line item for cnh
+1 SET FBA=^FBAAI(FBDA,0)
SET FBB=^(2)
SET FBC=$GET(^(3))
SET FBDOS=$PIECE(FBA,U,6)_"-"_$PIECE(FBA,U,7)
SET FBAMCL=$PIECE(FBA,U,8)
SET FBAMPD=$PIECE(FBA,U,9)
SET FBSUSP=$PIECE(FBA,U,11)
DO SUSP^FBCKDIS1
+2 SET FBVP=$PIECE(FBA,U,14)
SET FBREIM=$PIECE(FBA,U,13)
SET FBBAT=$PIECE(FBA,U,17)
SET FBINV=+FBA
+3 SET FBSUSPA=$FNUMBER($PIECE(FBA,U,10),"",2)
+4 SET FBFPPSC=$PIECE(FBC,U)
+5 SET FBFPPSL=$PIECE(FBC,U,2)
+6 SET FBX=$$ADJLRA^FBCHFA(FBDA_",")
+7 SET FBADJLR=$PIECE(FBX,U)
+8 SET FBADJLA=$PIECE(FBX,U,2)
+9 DO FBCKI^FBAACCB1(FBDA)
+10 QUIT
PHAR ;gather payment line item for pharmacy
+1 FOR I=1,2
SET FB(I)=$PIECE(FBDA,U,I)
+2 SET FBA=^FBAA(162.1,FB(1),"RX",FB(2),0)
SET FBB=^(2)
SET FBC=$GET(^(3))
SET FBDOS=$PIECE(FBA,U,3)
SET FBSRV=$PIECE(FBA,"^")
SET FBAMCL=$PIECE(FBA,U,4)
SET FBAMPD=$PIECE(FBA,U,16)
SET FBSUSP=$PIECE(FBA,U,8)
DO SUSP^FBCKDIS1
+3 SET FBVP=$PIECE(FBB,U,3)
SET FBREIM=$PIECE(FBA,U,20)
SET FBBAT=$PIECE($GET(FBA),U,17)
SET FBINV=+$GET(^FBAA(162.1,FB(1),0))
+4 SET FBSUSPA=$FNUMBER($PIECE(FBA,U,7),"",2)
+5 SET FBFPPSC=$PIECE($GET(^FBAA(162.1,FB(1),0)),U,13)
+6 SET FBFPPSL=$PIECE(FBC,U)
+7 SET FBX=$$ADJLRA^FBRXFA(FB(2)_","_FB(1)_",")
+8 SET FBADJLR=$PIECE(FBX,U)
+9 SET FBADJLA=$PIECE(FBX,U,2)
+10 DO FBCKP^FBAACCB1(FB(1),FB(2))
+11 QUIT
TRAV ;gather payment line item for travel
+1 FOR I=1,2
SET FB(I)=$PIECE(FBDA,U,I)
+2 SET FBA=^FBAAC(FB(1),3,FB(2),0)
SET FBDOS=+FBA
SET FBAMCL=$PIECE(FBA,U,3)
SET FBAMPD=FBAMCL
SET FBVP=""
SET FBREIM="R"
SET FBBAT=$PIECE(FBA,U,2)
SET FBINV=""
+3 DO FBCKT^FBAACCB0(FB(1),FB(2))
+4 QUIT
CLEAN ;clean up variables
+1 KILL I,FB,FBA,FBB,FBDOS,FBSRV,FBMOD,FBAMCL,FBAMPD,FBSUSP,FBVP,FBREIM,FBBAT,FBINV,FBDA,FBMODLE
+2 QUIT
OUTPUT ;display line items for check number
+1 IF $Y+5>IOSL
DO PGCHK
if $GET(FBAAOUT)
QUIT
+2 WRITE !
if FBVP="VP"
WRITE "#"
if FBREIM="R"
WRITE "*"
if FBCAN]""
WRITE "+"
Begin DoDot:1
+3 IF FBPROG["C"
Begin DoDot:2
+4 WRITE ?3,$$DATX^FBAAUTL($PIECE(FBDOS,"-")),?15,$$DATX^FBAAUTL($PIECE(FBDOS,"-",2)),?59,+$GET(^FBAA(161.7,+FBBAT,0)),?68,FBINV
+5 WRITE !?3,$JUSTIFY($FNUMBER(FBAMCL,",",2),10),?15,$JUSTIFY($FNUMBER(FBAMPD,",",2),10)
+6 ; write adjustment reasons, if null then write suspend code
+7 WRITE ?28,$SELECT(FBADJLR]"":FBADJLR,1:FBSUSP)
+8 ; write adjustment amounts, if null then write amount suspended
+9 WRITE ?38,$SELECT(FBADJLA]"":FBADJLA,1:FBSUSPA)
+10 IF FBFPPSC]""
WRITE !,?12,"FPPS Claim ID: ",FBFPPSC,?40,"FPPS Line Item: ",FBFPPSL
End DoDot:2
QUIT
+11 IF FBPROG="OPT"
Begin DoDot:2
+12 WRITE ?3,$$DATX^FBAAUTL(FBDOS),?13,$PIECE(FBSRV,","),?23,FBAARCE
+13 WRITE ?59,+$GET(^FBAA(161.7,+FBBAT,0)),?68,FBINV
+14 IF $PIECE(FBSRV,",",2)]""
Begin DoDot:3
+15 NEW FBI,FBMOD
+16 FOR FBI=2:1
SET FBMOD=$PIECE(FBSRV,",",FBI)
if FBMOD=""
QUIT
Begin DoDot:4
+17 IF $Y+5>IOSL
DO PGCHK
if $GET(FBAAOUT)
QUIT
WRITE !," (continued)"
+18 WRITE !,?18,"-",FBMOD
End DoDot:4
if $GET(FBAAOUT)
QUIT
End DoDot:3
if $GET(FBAAOUT)
QUIT
+19 WRITE !?3,$JUSTIFY($FNUMBER(FBAMCL,",",2),10),?15,$JUSTIFY($FNUMBER(FBAMPD,",",2),10)
+20 ; write adjustment reasons, if null then write suspend code
+21 WRITE ?28,$SELECT(FBADJLR]"":FBADJLR,1:FBSUSP)
+22 ; write adjustment amounts, if null then write amount suspended
+23 WRITE ?38,$SELECT(FBADJLA]"":FBADJLA,1:FBSUSPA)
+24 IF FBFPPSC]""
WRITE !,?12,"FPPS Claim ID: ",FBFPPSC,?40,"FPPS Line Item: ",FBFPPSL
End DoDot:2
QUIT
+25 IF FBPROG="PHAR"
Begin DoDot:2
+26 WRITE ?3,$$DATX^FBAAUTL(FBDOS),?13,FBSRV,?59,+$GET(^FBAA(161.7,+FBBAT,0)),?68,FBINV
+27 WRITE !?3,$JUSTIFY($FNUMBER(FBAMCL,",",2),10),?15,$JUSTIFY($FNUMBER(FBAMPD,",",2),10)
+28 ; write adjustment reasons, if null then write suspend code
+29 WRITE ?28,$SELECT(FBADJLR]"":FBADJLR,1:FBSUSP)
+30 ; write adjustment amounts, if null then write amount suspended
+31 WRITE ?38,$SELECT(FBADJLA]"":FBADJLA,1:FBSUSPA)
+32 IF FBFPPSC]""
WRITE !,?12,"FPPS Claim ID: ",FBFPPSC,?40,"FPPS Line Item: ",FBFPPSL
End DoDot:2
QUIT
+33 WRITE ?3,$$DATX^FBAAUTL(FBDOS)
if FBPROG'="TRAV"
WRITE ?13,FBSRV
WRITE ?20,$JUSTIFY($FNUMBER(FBAMCL,",",2),10),?32,$JUSTIFY($FNUMBER(FBAMPD,",",2),10)
if FBPROG'="TRAV"
WRITE ?47,FBSUSP
WRITE ?53,+$GET(^FBAA(161.7,+FBBAT,0)),?65,FBINV
End DoDot:1
if $GET(FBAAOUT)
QUIT
+34 SET A2=FBAMPD
DO PMNT^FBAACCB2
KILL A2
+35 QUIT
HED WRITE !?20,"PAYMENT HISTORY FOR CHECK # ",FBCN,!,?20,$EXTRACT(Q,1,(28+$LENGTH(FBCN))),?70,"Page: ",FBPG
+1 WRITE !!,?22,"FEE PROGRAM: ",$SELECT(FBPROG="OPT":"OUTPATIENT",FBPROG="CH":"CIVIL HOSPITAL",FBPROG="CNH":"COMMUNITY NURSING HOME",FBPROG="PHAR":"PHARMACY",FBPROG="TRAV":"TRAVEL",1:"")
+2 WRITE !?1,"('*' Reimbursement to Patient '#' Voided Payment '+' Cancellation Activity)"
+3 IF FBPROG["C"
Begin DoDot:1
+4 WRITE !?3,"From Date",?15,"To Date",?59,"Batch #",?68,"Invoice #"
+5 WRITE !?3,"Amt Claimed",?17,"Amt Paid",?28,"Adj Code",?38,"Adj Amount"
+6 WRITE !,QQ
End DoDot:1
QUIT
+7 IF FBPROG="TRAV"
WRITE !?3,"Travel Dt",?21,"Amount",?33,"Amount",?50,"Batch",?62,"Invoice",!,?21,"Claimed",?34,"Paid",?50,"Number",?62,"Number",!,QQ
QUIT
+8 IF FBPROG="OPT"
Begin DoDot:1
+9 WRITE !?3,"Svc Date",?13,"CPT-MOD",?23,"Rev.Code",?59,"Batch #",?68,"Invoice #"
+10 WRITE !?3,"Amt Claimed",?17,"Amt Paid",?28,"Adj Code",?38,"Adj Amount"
+11 WRITE !,QQ
End DoDot:1
QUIT
+12 IF FBPROG="PHAR"
Begin DoDot:1
+13 WRITE !?3,"Fill Dt",?13,"RX #",?56,"Batch #",?68,"Invoice #"
+14 WRITE !?3,"Amt Claimed",?17,"Amt Paid",?28,"Adj Code",?38,"Adj Amount"
+15 WRITE !,QQ
End DoDot:1
QUIT
+16 QUIT
PGCHK IF FBPG>1
IF ($EXTRACT(IOST,1,2)["C-")
WRITE !!
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET FBAAOUT=1
QUIT
+1 if FBPG>1
WRITE @IOF
DO HED
+2 SET FBPG=FBPG+1
QUIT
