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