Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAAVS

FBAAVS.m

Go to the documentation of this file.
  1. FBAAVS ;AISC/GRR-DISPLAY VENDOR PAYMENT RECORDS ;7/17/2003
  1. ;;3.5;FEE BASIS;**4,61**;JAN 30, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. RDP W !! S DIC="^FBAAC(",DIC(0)="AEQM",DIC("A")="Select Patient: " D ^DIC K DIC("A") G Q:X="^"!(X=""),RDP:Y<0 S DFN=+Y
  1. S:'$D(^FBAAC(DFN,1,0)) ^FBAAC(DFN,1,0)="^162.01P^0^0"
  1. RDV W !! S DIC="^FBAAV(",DIC(0)="AEQM",DA(1)=DFN D ^DIC G RDP:X="^"!(X=""),RDV:Y<0 S DA=+Y G:'$D(^FBAAC(DFN,DA,"AD")) NOCL D EN1
  1. G RDV
  1. EN1 ; display payments for veteran (DFN) and vendor (DA)
  1. N FBAARCE,FBADJLA,FBADJLR,FBCSID,FBFPPSC,FBFPPSL,FBRRMKL,FBUNITS
  1. N FBY2,FBY3,TAMT
  1. S Q="" F A=1:1:79 S Q=Q_"-",FBAAOUT=0
  1. S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP D HED
  1. F D=0:0 S D=$O(^FBAAC(DFN,DA,"AD",D)) Q:D'>0!(FBAAOUT) F B=0:0 S B=$O(^FBAAC(DFN,DA,"AD",D,B)) Q:B'>0!(FBAAOUT) F K=0:0 S K=$O(^FBAAC(DFN,1,DA,1,B,1,K)) Q:K'>0!(FBAAOUT) S L=^(K,0) D MORE,WRT
  1. W ! K B,C,D,T
  1. Q
  1. HED W @IOF,"Patient Name: ",$P(^DPT(DFN,0),"^",1),?50,"SSN: ",$P(^(0),"^",9),!!,?2,"VENDOR: ",$P(^FBAAV(DA,0),"^",1),!?5,$P(^FBAAV(DA,0),"^",3) S FBST=$P(^FBAAV(DA,0),"^",5)
  1. W !?5,$P(^FBAAV(DA,0),"^",4)_", "_$P($G(^DIC(5,+FBST,0)),U)_" "_$P(^FBAAV(DA,0),"^",6)
  1. W !,?10,"('*' Reimb. to Patient '+' Cancel. Activity '#' Voided Payment)"
  1. W !,?2,"SVC DATE",?12,"CPT-MOD",?22,"REV.CODE",?32,"UNITS",?39,"PATIENT ACCOUNT NO.",?61,"INVOICE #",?72,"BATCH #"
  1. W !,?12,"AMT CLAIMED",?25,"AMT PAID",?38,"ADJ CODE",?48,"ADJ AMOUNT",?65,"REMIT REMARK"
  1. W !,Q,!
  1. Q
  1. WRT I $E(IOST,1,2)["C-",$Y+3>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q:FBAAOUT D HED
  1. S FBAADT=$P(^FBAAC(DFN,1,DA,1,B,0),"^",1),FBAADT=$E(FBAADT,4,5)_"/"_$E(FBAADT,6,7)_"/"_$E(FBAADT,2,3),B1=$P(L,"^",8),B2=$S(B1="":"",$D(^FBAA(161.7,B1,0)):$P(^FBAA(161.7,B1,0),"^",1),1:"")
  1. S TAMT=$FN($P(L,U,4),"",2)
  1. S A1=$P(L,"^",2)+.0001,A2=$P(L,"^",3)+.0001,A1=$P(A1,".",1)_"."_$E($P(A1,".",2),1,2),A2=$P(A2,".",1)_"."_$E($P(A2,".",2),1,2),FBIN=$P(L,"^",16)
  1. S FBAACPT=$$CPT^FBAAUTL4($P(L,"^",1))
  1. S FBUNITS=$P(FBY2,U,14)
  1. S FBCSID=$P(FBY2,U,16)
  1. S FBFPPSC=$P(FBY3,U)
  1. S FBFPPSL=$P(FBY3,U,2)
  1. D FBCKO^FBAACCB2(DFN,DA,B,K)
  1. W !,$S(ZS="R":"*",1:""),$S(V="VP":"#",1:""),$S($G(FBCAN)]"":"+",1:"")
  1. W ?2,FBAADT,?12,FBAACPT_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:""),?22,FBAARCE,?32,FBUNITS,?39,FBCSID,?61,FBIN,?72,B2
  1. ; write additional modifiers (if any)
  1. I $P($G(FBMODLE),",",2)]"" D Q:FBAAOUT
  1. . N FBI,FBMOD
  1. . F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D Q:FBAAOUT
  1. . . I $Y+4>IOSL D Q:FBAAOUT
  1. . . . I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR I 'Y S FBAAOUT=1 Q
  1. . . . D HED W !,"(continued)"
  1. . . W !,?17,"-",FBMOD
  1. W !?12,"$",$J(A1,8),?25,"$",$J(A2,8)
  1. ; write adjustment reasons, if null then write suspend code
  1. W ?38,$S(FBADJLR]"":FBADJLR,1:T)
  1. ; write adjustment amounts, if null then write amount suspended
  1. W ?48,"$",$S(FBADJLA]"":FBADJLA,1:TAMT)
  1. W ?65,FBRRMKL
  1. I FBFPPSC]"" W !,?12,"FPPS Claim ID: ",FBFPPSC,?40,"FPPS Line Item: ",FBFPPSL
  1. D PMNT^FBAACCB2
  1. Q
  1. Q K DIC,DIE,DA,DF,DA(1),FBAAOUT,A,A1,A2,B1,B2,D1,FBAACPT,FBAADT,FBAAPD,FBIN,K,L,Q,X,Y,ZS,V,FBST,FBMODLE
  1. Q
  1. MORE N FBX
  1. S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_DFN_",1,"_DA_",1,"_B_",1,"_K_",""M"")","E")
  1. S T=$P(L,"^",5),T=$S(T>9:$P(^FBAA(161.27,T,0),"^"),1:T),ZS=$P(L,"^",20),V=$P(L,"^",21)
  1. S FBY2=$G(^FBAAC(DFN,1,DA,1,B,1,K,2))
  1. S FBY3=$G(^FBAAC(DFN,1,DA,1,B,1,K,3))
  1. S FBX=$$ADJLRA^FBAAFA(K_","_B_","_DA_","_DFN_",")
  1. S FBADJLR=$P(FBX,U)
  1. S FBADJLA=$P(FBX,U,2)
  1. S FBRRMKL=$$RRL^FBAAFR(K_","_B_","_DA_","_DFN_",")
  1. S FBAARCE=$$GET1^DIQ(162.03,K_","_B_","_DA_","_DFN_",",48)
  1. Q
  1. NOCL W !,"Vendor has no Payment data for this Patient!",! G RDV