| 1 | FBAAPH ;AISC/DMK,GRR-LIST PAYMENT HISTORY ;8/10/2003
|
|---|
| 2 | ;;3.5;FEE BASIS;**2,4,32,61**;JAN 30, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | D DT^DICRW
|
|---|
| 5 | RD K FBAANQ,FB,FBTRX W !! S FBAAOUT=0,DIC="^FBAAC(",DIC(0)="AEQMNZ",DIC("A")="Select Fee Patient: " D ^DIC K DIC("A") G Q:X="^"!(X=""),RD:Y<0 S DFN=+Y,FBNAME=Y(0,0)
|
|---|
| 6 | I '$D(^FBAAC(DFN,"AB")) W !!,"No payments for this patient!",! G RD
|
|---|
| 7 | S FBSSN=$$SSN^FBAAUTL(DFN)
|
|---|
| 8 | D HOME^%ZIS ;S VAR="FBNAME^DFN",VAL=FBNAME_"^"_DFN,PGM="LIST^FBAAPH" D ZIS^FBAAUTL G:FBPOP Q S:IO=IO(0) FBAANQ=1
|
|---|
| 9 | LIST S:'$D(FBNAME) FBNAME=$P($G(^DPT(+DFN,0)),"^")
|
|---|
| 10 | S FBPHOUT=1
|
|---|
| 11 | U IO S FBAAOUT=0 D ^FBAADEM I FBAAOUT'=1,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR G Q:$D(DIRUT)
|
|---|
| 12 | K Q S $P(Q,"=",80)="="
|
|---|
| 13 | S FBAAOUT=0 W:$E(IOST,1,2)["C-" @IOF D HED S J=DFN
|
|---|
| 14 | F I=0:0 S I=$O(^FBAAC(J,"AB",I)) Q:I=""!(FBAAOUT) F K=0:0 S K=$O(^FBAAC(J,"AB",I,K)) Q:K=""!(FBAAOUT) F L=0:0 S L=$O(^FBAAC(J,"AB",I,K,L)) Q:L=""!(FBAAOUT) D SETTR F M=0:0 S M=$O(^FBAAC(J,1,K,1,L,1,M)) Q:'M D SET Q:FBAAOUT
|
|---|
| 15 | G RD:FBAAOUT!('$D(FB)) S FBTRCK=1,D=0 F S D=$O(FB(D)) Q:'D S FBTRX=0 F S FBTRX=$O(FB(D,FBTRX)) Q:'FBTRX D WRTCK Q:FBAAOUT W:$G(FBTRCK) !!,?5,"TRAVEL PAYMENTS: " D K FBTRCK
|
|---|
| 16 | .W ?22,$$DATX^FBAAUTL(D),?35,$P(FB(D,FBTRX),"^") I $P(FB(D,FBTRX),"^",3)]"" W ?44,"Check #: ",$P(FB(D,FBTRX),"^",2),?63,"Paid: ",$$DATX^FBAAUTL($P(FB(D,FBTRX),"^",3))
|
|---|
| 17 | G RD
|
|---|
| 18 | W !! D CLOSE^FBAAUTL K FBNAME,DFN,J,FBAANQ,FBAAOUT,DIC,VAL,VAR,PGM Q
|
|---|
| 19 | SET ;
|
|---|
| 20 | N FBAARCE,FBADJLA,FBADJLR,FBCSID,FBFPPSC,FBFPPSL,FBRRMKL,FBUNITS
|
|---|
| 21 | N FBX,FBY2,FBY3,TAMT
|
|---|
| 22 | S V=$P($G(^FBAAV(K,0)),"^"),FBVID=$S(V]"":$P(^(0),"^",2),1:"")
|
|---|
| 23 | S Y=^FBAAC(J,1,K,1,L,1,M,0),T=$P(Y,"^",5),D2=$P(Y,"^",6),FBDOS=D2,D2=$S(D2="":"",1:$E(D2,4,5)_"/"_$E(D2,6,7)_"/"_$E(D2,2,3)),FBCP=$P(Y,"^",18),FBCP=$S(FBCP=1:"(C&P)",1:"")
|
|---|
| 24 | S FBAACPTC=$$CPT^FBAAUTL4(+Y)
|
|---|
| 25 | S FBOB=$P(Y,"^",10)
|
|---|
| 26 | I T]"" S T=$P($G(^FBAA(161.27,+T,0)),"^")
|
|---|
| 27 | S A1=$P(Y,"^",2)+.0001,A2=$P(Y,"^",3)+.0001,A1=$P(A1,".",1)_"."_$E($P(A1,".",2),1,2),A2=$P(A2,".",1)_"."_$E($P(A2,".",2),1,2)
|
|---|
| 28 | S FBAPS=$$APS^FBAAUTL4(J,K,L,M)
|
|---|
| 29 | S FBTYPE=$P(Y,"^",20),FBVP=$P(Y,"^",21),FBIN=$P(Y,"^",16),FBBN=$P(Y,"^",8),FBBN=$S(FBBN']"":"",$D(^FBAA(161.7,FBBN,0)):$P(^(0),"^"),1:""),FBBN=$S(FBBN="":"",1:$E("00000",$L(FBBN)+1,5)_FBBN)
|
|---|
| 30 | S FBY3=$G(^FBAAC(J,1,K,1,L,1,M,3))
|
|---|
| 31 | S FBFPPSC=$P(FBY3,U)
|
|---|
| 32 | S FBFPPSL=$P(FBY3,U,2)
|
|---|
| 33 | S FBX=$$ADJLRA^FBAAFA(M_","_L_","_K_","_J_",")
|
|---|
| 34 | S FBADJLR=$P(FBX,U)
|
|---|
| 35 | S FBADJLA=$P(FBX,U,2)
|
|---|
| 36 | S TAMT=$FN($P(Y,"^",4),"",2)
|
|---|
| 37 | S FBAARCE=$$GET1^DIQ(162.03,M_","_L_","_K_","_J_",",48)
|
|---|
| 38 | S FBY2=$G(^FBAAC(J,1,K,1,L,1,M,2))
|
|---|
| 39 | S FBUNITS=$P(FBY2,U,14)
|
|---|
| 40 | S FBCSID=$P(FBY2,U,16)
|
|---|
| 41 | S FBRRMKL=$$RRL^FBAAFR(M_","_L_","_K_","_J_",")
|
|---|
| 42 | D FBCKO^FBAACCB2(J,K,L,M)
|
|---|
| 43 | S FBMODLE=$$MODL^FBAAUTL4("^FBAAC("_J_",1,"_K_",1,"_L_",1,"_M_",""M"")","E")
|
|---|
| 44 | D WRT
|
|---|
| 45 | Q
|
|---|
| 46 | WRT D WRTCK Q:FBAAOUT
|
|---|
| 47 | W !!,"Vendor: ",$E(V,1,33)," Vendor ID: ",FBVID,?66," Obl.#: "_FBOB
|
|---|
| 48 | W !,$S(FBTYPE="R":"*",1:" "),$S(FBVP="VP":"#",1:""),$S($G(FBCAN)]"":"+",1:""),?2,$$DATX^FBAAUTL(D),?12,FBAACPTC,FBCP_$S($G(FBMODLE)]"":"-"_$P(FBMODLE,","),1:""),?22,FBAARCE,?31,FBUNITS,?38,FBCSID,?60,$J(FBIN,7),?71,FBBN
|
|---|
| 49 | I $P($G(FBMODLE),",",2)]"" D Q:FBAAOUT
|
|---|
| 50 | . N FBI
|
|---|
| 51 | . F FBI=2:1 S FBMOD=$P(FBMODLE,",",FBI) Q:FBMOD="" D Q:FBAAOUT
|
|---|
| 52 | . . I $Y+5>IOSL D WRTCK Q:FBAAOUT W !,"(continued)"
|
|---|
| 53 | . . W !,?17,"-",FBMOD
|
|---|
| 54 | W !?5,$J(A1,6),?18,$J(A2,6),FBAPS
|
|---|
| 55 | ; write adjustment reasons, if null then write suspend code
|
|---|
| 56 | W ?32,$S(FBADJLR]"":FBADJLR,1:T)
|
|---|
| 57 | ; write adjustment amounts, if null then write amount suspended
|
|---|
| 58 | W ?42,$S(FBADJLA]"":FBADJLA,1:TAMT)
|
|---|
| 59 | W ?58,FBRRMKL,?71,D2
|
|---|
| 60 | I FBFPPSC]"" W !,?5,"FPPS Claim ID: ",FBFPPSC,?32,"FPPS Line Item: ",FBFPPSL
|
|---|
| 61 | D PMNT^FBAACCB2
|
|---|
| 62 | Q
|
|---|
| 63 | WRTCK I ($Y+5)>IOSL,$E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q:FBAAOUT
|
|---|
| 64 | I ($Y+5)>IOSL W @IOF D HED
|
|---|
| 65 | Q
|
|---|
| 66 | HED I $E(IOST,1,2)'="C-" W !?24,"MEDICAL PAYMENT HISTORY",!?23,$E(Q,1,25)
|
|---|
| 67 | W !,"Patient: ",FBNAME,?40,"SSN: ",$$SSN^FBAAUTL(DFN),!,?10,"('*' Reimb. to Patient '+' Cancel. Activity '#' Voided Payment)"
|
|---|
| 68 | W !,?4,"(paid symbol: 'R' RBRVS 'F' 75th percentile 'C' contract 'M' Mill Bill"
|
|---|
| 69 | W !,?4," 'U' U&C)"
|
|---|
| 70 | W !,?2,"Svc Date",?12,"CPT-MOD",?22,"Rev.Code",?31,"Units",?38,"Patient Account No.",?60,"Invoice #",?71,"Batch #"
|
|---|
| 71 | W !?5,"Amt Claimed",?18,"Amt Paid",?32,"Adj Code",?42,"Adj Amount",?58,"Remit Remark",?71,"VoucherDt"
|
|---|
| 72 | W !,Q,!
|
|---|
| 73 | Q
|
|---|
| 74 | Q K D,D2,J,K,L,M,DIC,T,Y,Q,I,A1,A2,A3,C,DAT,DIYS,F,FBAACPTC,FBAANQ,FBAAOUT,FBBN,FBCOUNTY,FBCP,FBOB,FBDOS,FBDX,FBIN,FBTA,FBTYPE,FBVID,FBNAME,PGM,PI,V,VAL,VAR,Z,ZZ,A,A1,A2,BE,CPTDESC,FBVP,PSA,FBPHOUT,FBAUT
|
|---|
| 75 | K B1AUT,B2,DFN,FBAADOD,PTYPE,FBI,FBRR,FBPROG,FBXX,FBSSN,X1,FBAACPT,FBAADT,FBAAPD,FBIN,I,K,L,Q,Y,Z,ZS,FB,FBTRX,FBMOD,FBMODLE,FBAPS
|
|---|
| 76 | D CLOSE^FBAAUTL Q
|
|---|
| 77 | SETTR S D=$S($D(^FBAAC(J,1,K,1,L,0)):$P(^(0),"^",1),1:""),A3=""
|
|---|
| 78 | I D]"",$D(^FBAAC(J,3,"AB",D)) S (FBTA,FBCTR)=0 F S FBTA=$O(^FBAAC(J,3,"AB",D,FBTA)) Q:'FBTA S B3=$G(^FBAAC(J,3,FBTA,0)),A3=$P(B3,"^",3) I A3>0 S FBCTR=FBCTR+1,FB(D,FBCTR)=$J(A3,6,2)_"^"_$P(B3,"^",7)_"^"_$P(B3,"^",6)
|
|---|
| 79 | K A3,B3,FBTA,FBCTR Q
|
|---|
