130 lines
7.0 KiB
Mathematica
130 lines
7.0 KiB
Mathematica
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
|