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

FBAACCB1.m

Go to the documentation of this file.
  1. FBAACCB1 ;AISC/GRR-CLERK CLOSE BATCH CONTINUED ; 11/24/10 10:27am
  1. ;;3.5;FEE BASIS;**55,61,116,108,164**;JAN 30, 1995;Build 28
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. PHARM ;ENTRY FOR PHARMACY BATCH CALCULATE TOTAL DOLLARS AND LINE COUNT
  1. ; HIPAA 5010 - count line items that have 0.00 amount paid
  1. F A=0:0 S A=$O(^FBAA(162.1,"AE",B,A)) Q:A'>0 F B2=0:0 S B2=$O(^FBAA(162.1,"AE",B,A,B2)) Q:B2'>0 I $D(^FBAA(162.1,A,"RX",B2,0)) S Z(0)=^(0) D MOREP
  1. G FIN^FBAACCB
  1. MOREP S T=T+$P(Z(0),"^",16),C=C+1 Q
  1. ;
  1. TRAV ;ENTRY FOR TRAVEL BATCH CALCULATE TOTAL DOLLARS AND LINE COUNT
  1. ; HIPAA 5010 - count line items that have 0.00 amount paid
  1. F J=0:0 S J=$O(^FBAAC("AD",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAAC("AD",B,J,K)) Q:K'>0 I $D(^FBAAC(J,3,K,0)) S Z(0)=^(0) D MORET
  1. G FIN^FBAACCB
  1. ;
  1. MORET S T=T+$P(Z(0),"^",3),C=C+1 Q
  1. LISTC S Q="",$P(Q,"=",80)="=",(FBAAOUT,FBLISTC)=0,IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP
  1. PRTC D HEDC
  1. F I=0:0 S I=$O(^FBAAI("AC",B,I)) Q:I'>0!(FBAAOUT) I $D(^FBAAI(I,0)) S Z(0)=^(0) D CMORE
  1. Q
  1. CMORE N FBADJLR,FBFPPSC,FBFPPSL,FBX,FBY3,FBDX,FBPOA,FBADMTDX
  1. S K=$P(Z(0),"^",3),J=$P(Z(0),"^",4) D ENV^FBAACCB0 S N=$$NAME^FBCHREQ2(J),S=$$SSN^FBAAUTL(J),FBIN=I,FBAC=$P(Z(0),"^",8)+.0001,FBAP=$P(Z(0),"^",9)+.0001,FBVP=$P(Z(0),"^",14),ZS=$P(Z(0),"^",13)
  1. S FBAC=$P(FBAC,".",1)_"."_$E($P(FBAC,".",2),1,2),FBAP=$P(FBAP,".",1)_"."_$E($P(FBAP,".",2),1,2)
  1. S FBSC=$P(Z(0),"^",11),FBSC=$S(FBSC="":"",$D(^FBAA(161.27,FBSC,0)):$P(^(0),"^",1),1:""),FBFD=$P(Z(0),"^",6),FBTD=$P(Z(0),"^",7) S FBPDT=FBFD D CDAT S FBFD=FBPDT,FBPDT=FBTD D CDAT S FBTD=FBPDT
  1. S FBY3=$G(^FBAAI(I,3))
  1. S FBFPPSC=$P(FBY3,U)
  1. S FBFPPSL=$P(FBY3,U,2)
  1. S FBX=$$ADJLRA^FBCHFA(I_",")
  1. S FBADJLR=$P(FBX,U)
  1. D FBCKI(I)
  1. S B(1617)=$S(B="":"",$D(^FBAA(161.7,B,0)):$P(^(0),"^"),1:"")
  1. S FBIN(1)=$P(Z(0),"^",2)
  1. D WRITC
  1. Q
  1. WRITC I $Y+7>IOSL D ASKH^FBAACCB0:$E(IOST,1,2)["C-" Q:FBAAOUT W @IOF D HEDC
  1. W !!,$S('$D(ZS):"",ZS="R":"*",1:"")
  1. W N,?35,S,?60,B(1617)
  1. W !,?3,V,?45,VID,?58,FBIN,?70,$$DATX^FBAAUTL($E(FBIN(1),1,7))
  1. I FBFPPSC]"" W !,?4,"FPPS Claim ID: ",FBFPPSC," FPPS Line: ",FBFPPSL
  1. W !,$S($D(QQ):QQ_")",1:""),FBVP,$S(FBCAN]"":"+",1:""),?4,FBFD,?13,FBTD,?22,$J(FBAC,6),?32,$J(FBAP,6),?45,$S(FBADJLR]"":FBADJLR,1:FBSC)
  1. W:$P(Z(0),"^",24) ?56,"Discharge ",$$ICD^FBCSV1(+$P(Z(0),"^",24),$P(Z(0),"^",6)) W ! ;CSV
  1. ; write admitting diagnosis
  1. N P7,P8
  1. S P7=$G(^FBAAI(I,5))
  1. S FBADMTDX=$P(P7,"^",9)
  1. S P8=$$ICD9^FBCSV1(FBADMTDX,$P($G(Z(0)),"^",6))
  1. I P8'="" W !,?4,"Admit Dx: ",P8
  1. ; set diagnosis code and present on admission code
  1. N P1,P2
  1. S P1=$G(^FBAAI(I,"DX"))
  1. S P2=$G(^FBAAI(I,"POA"))
  1. F FBK=1:1:25 D WRTDX
  1. ; set procedure code
  1. N P5
  1. S P5=$G(^FBAAI(I,"PROC"))
  1. F FBL=1:1:25 D WRTPC
  1. ; write attachment IDs
  1. I $D(^FBAAI(I,10)) D
  1. . N AI,AID,AITI,WRTPC
  1. . S AI=0 S WRTPC="Attachment ID:"
  1. . F S AI=$O(^FBAAI(I,10,AI)) Q:'AI D
  1. . . S AID=$P($G(^FBAAI(I,10,AI,0)),"^") I AI>1 S WRTPC=WRTPC_","
  1. . . S WRTPC=WRTPC_" "_AID
  1. . . S AITI=$P($G(^FBAAI(I,10,AI,0)),"^",2) I AITI D
  1. . . . S WRTPC=WRTPC_" ("_$P($G(^IBE(353.3,AITI,0)),"^")
  1. . . . S WRTPC=WRTPC_" - "
  1. . . . S WRTPC=WRTPC_$P($G(^IBE(353.3,AITI,0)),"^",2)_")"
  1. . . I $L(WRTPC)>IOM D WRTSTR(.WRTPC,IOM)
  1. . I $L(WRTPC)>0 D WRTSTR(.WRTPC,IOM)
  1. S A2=FBAP D PMNT^FBAACCB2 K A2
  1. Q
  1. WRTSTR(STR,MX) ; Wordwrap string
  1. N RM,I
  1. WRTSTR1 S RM=$S(STR?1"Attachment ID:".E:MX-4,1:MX-7)
  1. F I=1:1:$L(STR," ") Q:$L($P(STR," ",1,I))>RM
  1. W !,?4 W:STR'?1"Attachment ID:".E ?7
  1. I $L($P(STR," ",1,I))>RM W $P(STR," ",1,I-1) S STR=$P(STR," ",I,999)
  1. E W $P(STR," ",1,I) S STR=""
  1. I $L(STR)>(MX-3) G WRTSTR1
  1. Q
  1. CDAT S FBPDT=$E(FBPDT,4,5)_"/"_$S($E(FBPDT,6,7)="00":$E(FBPDT,2,3),1:$E(FBPDT,6,7)_"/"_$E(FBPDT,2,3))
  1. Q
  1. HEDC W "Patient Name",?20,"('*' Reimbursement to Veteran '+' Cancellation Activity)",!,?13,"('#' Voided Payment '&' Additional Payment)",?60,"Batch Number"
  1. W !,?3,"Vendor Name",?45,"Vendor ID",?57,"Invoice #",?68,"Dt Inv Rec'd",!,?3,"FR DATE",?14,"TO DATE CLAIMED PAID",?41,"ADJ CODE",!,Q,!
  1. Q
  1. CHNH ; FB*3.5*116
  1. S (J,FZ("CNT"))=0 F S J=$O(^FBAAI("AC",B,J)) Q:J'>0 I $D(^FBAAI(J,0)) S Z(0)=^(0) D MORECH D:$P(FZ,U,15)'="Y" INVCNT
  1. S:$G(FZ("CNT")) $P(FZ,U,10)=FZ("CNT") K FZ("CNT") ; CNH batch
  1. G FIN^FBAACCB
  1. ;
  1. MORECH ; HIPAA 5010 - count line items that have 0.00 amount paid
  1. S T=T+$P(Z(0),"^",9),C=C+1
  1. ; FB*3.5*116 - build array of invoices
  1. ;do not build array for CH batches not exempt from the pricer
  1. Q:($P(FZ,"^",18)'="Y")&($P(FZ,"^",15)="Y")
  1. S FBARY($P(Z(0),"^"))=+$P(Z(0),"^",9)
  1. Q
  1. ;
  1. WRTDX ; write diagnosis code and present on admission code
  1. N P3,P4
  1. S FBDX=$P(P1,"^",FBK)
  1. S FBPOA=$P(P2,"^",FBK)
  1. Q:FBDX=""
  1. S P3=$$ICD9^FBCSV1(FBDX,$P($G(Z(0)),"^",6))_"/"
  1. S P4=P3_$S(FBPOA:$P($G(^FB(161.94,FBPOA,0)),"^"),1:"")
  1. I FBK=1!($X+$L(P4)+2>IOM) W !,?4,"DX/POA: "
  1. W P4," "
  1. Q
  1. ;
  1. WRTPC ; write procedure code (if present)
  1. N P6
  1. S FBPROC=$P(P5,"^",FBL)
  1. Q:FBPROC=""
  1. S P6=$$ICD0^FBCSV1(FBPROC,$P($G(Z(0)),"^",6))
  1. I FBL=1!($X+$L(P6)+2>IOM) W !,?4,"PROC: "
  1. W P6," "
  1. Q
  1. MORE ;
  1. N FBADJLA,FBADJLR,FBFPPSC,FBFPPSL,FBX,TAMT
  1. S J=$P(Z(0),"^",5),D=$P(Z(0),"^",3),FBAACPT=$P(Z(0),"^",1),N=$S($D(^DPT(J,0)):$P(^(0),"^",1),1:""),S=$S(N]"":$P(^DPT(J,0),"^",9),1:""),FBIN=A,CPTDESC=$P(Z(0),"^",2)
  1. S Y="",$P(Y,"^",2)=$P(Z(0),"^",4),$P(Y,"^",3)=$P(Z(0),"^",16),$P(Y,"^",12)=0,T=$P(Z(0),"^",8),T=$S(T="":"",$D(^FBAA(161.27,T,0)):^(0),1:""),$P(Y,"^",9)=$P(Z(0),"^",1),ZS=$P(Z(0),"^",20),FBPV=""
  1. ;
  1. S FBFPPSC=$P($G(^FBAA(162.1,A,0)),U,13)
  1. S FBFPPSL=$P($G(^FBAA(162.1,A,"RX",B2,3)),U)
  1. S FBX=$$ADJLRA^FBRXFA(B2_","_A_",")
  1. S FBADJLR=$P(FBX,U)
  1. S FBADJLA=$P(FBX,U,2)
  1. S TAMT=$FN($P(Z(0),"^",7),"",2)
  1. ;
  1. D FBCKP(A,B2)
  1. S FBIN(1)=$P($G(^FBAA(162.1,+A,0)),"^",2)
  1. G GO^FBAACCB
  1. INVCNT ;set invoice count for cnh batch
  1. S FZ("CNT")=FZ("CNT")+1
  1. Q
  1. FBCKI(FBI) ;set inpatient check variables
  1. ;fbi=DA
  1. I '$G(FBI) S (FBCKDT,FBCK,FBCANDT,FBCANR,FBCAN,FBDIS,FBCKINT)="" Q
  1. S FBCKIN=$G(^FBAAI(FBI,2))
  1. S U="^",FBCKDT=+FBCKIN,FBCK=$P(FBCKIN,U,4),FBCANDT=$P(FBCKIN,U,5),FBCANR=$P(FBCKIN,U,6),FBCAN=$P(FBCKIN,U,7),FBDIS=$P(FBCKIN,U,8),FBCKINT=$P(FBCKIN,U,9) K FBCKIN
  1. Q
  1. FBCKP(J,K) ;set pharmacy check variables
  1. ;j,k required input variables to = da(1) and da respectively (162.1)
  1. I '$G(J)!('$G(K)) Q
  1. S FBCKIN=$G(^FBAA(162.1,J,"RX",K,2))
  1. S U="^",FBCKDT=$P(FBCKIN,U,8),FBCK=$P(FBCKIN,U,10),FBCANDT=$P(FBCKIN,U,11),FBCANR=$P(FBCKIN,U,12),FBCAN=$P(FBCKIN,U,13),FBDIS=$P(FBCKIN,U,14),FBCKINT=$P(FBCKIN,U,15) K FBCKIN
  1. Q