| 1 | FBAACP1 ;AISC/CMR-C&P PAYMENT DRIVER ;7/17/2003
 | 
|---|
| 2 |  ;;3.5;FEE BASIS;**4,61**;JAN 30, 1995
 | 
|---|
| 3 |  ;;Per VHA Directive 10-93-142, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 | FILE ;files sp multiple entry
 | 
|---|
| 6 |  S DIE="^FBAAC("_DFN_",1,"_FBV_",1,"_FBSDI_",1,",DA(3)=DFN,DA(2)=FBV,DA(1)=FBSDI,DA=FBAACPI
 | 
|---|
| 7 |  S TP="",DR="1///^S X=FBAAAMT;Q;2///^S X="_$S($G(FBDEN):0,1:FBAAAMT)_";I '$G(FBDEN) S Y=6;3//^S X=FBAAAMT;3.5///^S X=DT;@4;4;I X']"""" D SC^FBAACO3;S:X'=4 Y=6;22;6////^S X=DUZ;7////^S X=FBAABE"
 | 
|---|
| 8 |  S DR=DR_";8////^S X=BO;13///^S X=FBAAID;14///^S X=FBAAIN;15///^S X=FBPT;23////^S X=2;33///^S X=FBAAVID;16////^S X=FBPOV;17///^S X=FBTT;18///^S X=FBAAPTC;26////^S X=FBPSA"
 | 
|---|
| 9 |  S DR(1,162.03,1)="34///^S X=$G(FBAAMM1);28////^S X=FBHCFA(28);30///^S X=FBHCFA(30);31////^S X=FBHCFA(31);44///^S X=FBFSAMT;45////^S X=FBFSUSD;48///^S X=FBAARC;47///^S X=FBUNITS;S FBTST=1"
 | 
|---|
| 10 |  D LOCK^FBUCUTL("^FBAAC(",DFN,1)
 | 
|---|
| 11 |  D ^DIE
 | 
|---|
| 12 |  I $G(FBTST) D
 | 
|---|
| 13 |  . D FILERR^FBAAFR(FBAACPI_","_FBSDI_","_FBV_","_DFN_",",.FBRRMK)
 | 
|---|
| 14 |  L -^FBAAC(DFN)
 | 
|---|
| 15 |  I '$G(FBTST),$G(DA) S DIR(0)="YA",DIR("A")="Entering an '^' will delete "_$S($G(FBDEN):"denial",1:"payment")_".  Are you sure you want to delete? ",DIR("B")="No" D ^DIR K DIR G FILE:'$D(DIRUT)&('Y) D KILL^FBAACO2 Q
 | 
|---|
| 16 |  S FBINTOT=FBINTOT+FBAAAMT
 | 
|---|
| 17 |  I FBAAAMT>0 S Z1=$P(^FBAA(161.7,FBAABE,0),"^",11)+1,$P(^(0),"^",11)=Z1
 | 
|---|
| 18 |  W !,$S($G(FBDEN):"Denial",1:"Payment")," Data Entered for Patient"
 | 
|---|
| 19 |  K FBDEN,FBAAMM1,FBTST,DIE,DR,DA
 | 
|---|
| 20 |  Q
 | 
|---|
| 21 |  ;
 | 
|---|
| 22 | PAID ;called from fbaacp to reset fee schedule if user opts to edit
 | 
|---|
| 23 |  ;a service.  If fee schedule of new cpt_modifier=0 tell user
 | 
|---|
| 24 |  ;not allowed in this option and refer to edit payment option.
 | 
|---|
| 25 |  ;
 | 
|---|