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

FBAAPPH.m

Go to the documentation of this file.
  1. FBAAPPH ;AISC/GRR-PHARMACY HISTORY LIST FOR PATIENT ;7/17/2003
  1. ;;3.5;FEE BASIS;**12,61**;JAN 30, 1995
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. D DT^DICRW S FBAAOUT=0
  1. RD K FBAANQ W !! S FBAAOUT=0,DIC="^FBAAA(",DIC(0)="AEQM" D ^DIC G Q:X=""!(X="^"),RD:Y<0 S DFN=+Y
  1. I '$D(^FBAA(162.1,"AD",DFN)) W !!,*7,"No payments for this patient!" G RD
  1. S VAR="DFN",VAL=DFN,PGM="LIST^FBAAPPH" D ZIS^FBAAUTL G:FBPOP Q S:IO=IO(0) FBAANQ=1
  1. LIST ; list prescriptions for patient (DFN)
  1. N FBADJLA,FBADJLR,FBFPPSC,FBFPPSL,FBRRMKL,FBSUSPA,FBX
  1. S Q="" S $P(Q,"=",80)="="
  1. S FSW=1 U IO I $E(IOST,1,2)="C-" W @IOF
  1. S (FBAAOUT,J,K,L)=0
  1. I '$O(^FBAA(162.1,"AD",DFN,0)) W !,"Patient has no Pharmacy payment history.",! Q
  1. F S J=$O(^FBAA(162.1,"AD",DFN,J)) Q:J'>0!(FBAAOUT) F S K=$O(^FBAA(162.1,"AD",DFN,J,K)) Q:K'>0!(FBAAOUT) F S L=$O(^FBAA(162.1,"AD",DFN,J,K,L)) Q:L'>0!(FBAAOUT) D GOT Q:FBAAOUT
  1. I FBAAOUT,$E(IOST,1,2)="C-" W @IOF
  1. G:$D(FBAANQ) RD
  1. Q K DIC,DOB,J,K,L,DFN,FBAANQ,FBRX,FBFD,FBAC,FBAP,A1,A2,FBPV,FBSUSP,FBSTR,FBQTY,FBAAOUT,FSW,FID,CHN,FBBATCH,FBDRUG,FBINVN,FBPD,FBREIM,N,NAME,Q,FBSSN,VAL,VAR,VID,PGM,VNAM,X,Y,I,FBSAR,FBI
  1. W:$E(IOST,1,2)'="C-" @IOF D CLOSE^FBAAUTL Q
  1. ;
  1. GOT S FBSSN=$$SSN^FBAAUTL(DFN),N=$G(^DPT(+DFN,0)),NAME=$P(N,"^"),DOB=$P(N,"^",3),DOB=$S(DOB]"":$$FMTE^XLFDT(DOB),1:"")
  1. Q:'$D(^FBAA(162.1,K,0))&('$D(^FBAA(162.1,K,"RX",L,0)))
  1. S Y(0)=$G(^FBAA(162.1,K,"RX",L,0))
  1. S Y(2)=$G(^FBAA(162.1,+K,0))
  1. I $D(^FBAA(162.1,K,"RX",L,2)) S Y(1)=^(2)
  1. S FBFPPSL=$P($G(^FBAA(162.1,K,"RX",L,3)),U)
  1. S FBX=$$ADJLRA^FBRXFA(L_","_K_",")
  1. S FBADJLR=$P(FBX,U)
  1. S FBADJLA=$P(FBX,U,2)
  1. S FBRRMKL=$$RRL^FBRXFR(L_","_K_",")
  1. S FBINVN=$P(Y(2),"^"),VID=$P(Y(2),"^",4),CHN=$G(^FBAAV(+VID,0)),VNAM=$P(CHN,"^"),FID=$P(CHN,"^",2),CHN=$P(CHN,"^",10)
  1. S FBFPPSC=$P(Y(2),U,13)
  1. S FBRX=$P(Y(0),"^",1),FBDRUG=$P(Y(0),"^",2),FBFD=$P(Y(0),"^",3),FBAC=$P(Y(0),"^",4),FBAP=$P(Y(0),"^",16),FBSUSP=$P(Y(0),"^",8),FBPD=$P(Y(0),"^",19),FBBATCH=$P(Y(0),"^",17),FBBATCH=$P($G(^FBAA(161.7,+FBBATCH,0)),"^")
  1. S FBSUSPA=$FN($P(Y(0),U,7),"",2)
  1. I FBSUSP=4,FBADJLR="" S FBI=0 F S FBI=$O(^FBAA(162.1,K,"RX",L,1,FBI)) Q:'FBI S FBSAR(FBI)=^(FBI,0)
  1. I FBSUSP]"" S FBSUSP=$P($G(^FBAA(161.27,+FBSUSP,0)),"^")
  1. S FBREIM=$S($P(Y(0),"^",20)="R":"*",1:""),FBSTR=$P(Y(0),"^",12),FBQTY=$P(Y(0),"^",13),A1=FBAC+.00001,A2=FBAP+.00001,A1=$P(A1,".",1)_"."_$E($P(A1,".",2),1,2),A2=$P(A2,".",1)_"."_$E($P(A2,".",2),1,2),FBPV=""
  1. I $D(Y(1)) S FBPV=$S($P(Y(1),"^",3)="V":"#",1:"")
  1. D FBCKP^FBAACCB1(K,L)
  1. WRT I FSW S FSW=0 D HED
  1. I $E(IOST,1,2)="C-",$Y+7>IOSL S DIR(0)="E" D ^DIR K DIR S:'Y FBAAOUT=1 Q:FBAAOUT W @IOF D HED
  1. I $Y+6>IOSL W @IOF D HED
  1. W !!,VNAM,?48,FID,?60,CHN
  1. W !,FBREIM,FBPV,?3,$E(FBFD,4,5),"/",$E(FBFD,6,7),"/",$E(FBFD,2,3),?64,$S(FBPD="":"",1:$E(FBPD,4,5)_"/"_$E(FBPD,6,7)_"/"_$E(FBPD,2,3))
  1. W !," Rx: "_FBRX,?15,FBDRUG,?45,FBSTR,?63,FBQTY
  1. W !,?4,$J(A1,6),?13,$J(A2,6)
  1. ; write adjustment reasons, if null then write suspend code
  1. W ?22,$S(FBADJLR]"":FBADJLR,1:FBSUSP)
  1. ; write adjustment amounts, if null then write amount suspended
  1. W ?32,$S(FBADJLA]"":FBADJLA,1:FBSUSPA)
  1. W ?47,FBINVN,?58,FBBATCH,?67,FBRRMKL
  1. I FBFPPSC]"" W !,?5,"FPPS Claim ID: ",FBFPPSC," FPPS Line Item: ",FBFPPSL
  1. I $D(FBSAR) W !?5,"Suspension Description: " S FBI=0 F S FBI=$O(FBSAR(FBI)) Q:'FBI W " ",FBSAR(FBI)
  1. D PMNT^FBAACCB2
  1. K FBSAR Q
  1. HED W:$E(IOST,1,2)'="C-" !?25,"PHARMACY PAYMENT HISTORY",!?24,$E(Q,1,26)
  1. W !,"Patient: ",NAME,?41,"Pt ID: ",FBSSN,?60,"DOB: ",DOB
  1. W !,"('*' Reimbursement to Patient '+' Cancellation Activity) '#' Voided Payment)"
  1. W !,"Vendor Name",?48,"ID #",?60,"Chain #"
  1. W !,?3,"Fill Date",?64,"Date Certified"
  1. W !,?15,"Drug Name",?43,"Strength",?61,"Quantity"
  1. W !,?3,"Claimed",?15,"Paid",?22,"Adj Code",?32,"Adj Amount",?47,"Invoice #",?58,"Batch #",?67,"Remit Remark"
  1. W !,Q
  1. Q