FBAAPIP ;AISC/GRR - ESTABLISH BATCH FOR INVOICE AND CLOSE-OUT ;11/24/2014
;;3.5;FEE BASIS;**116,154**;JAN 30, 1995;Build 12
;;Per VA Directive 6402, this routine should not be modified.
D DT^DICRW S FBSW=1
RD1 W !! S DIC="^FBAA(162.1,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,5)=3" D ^DIC K DIC G Q:X="^"!(X=""),RD1:Y<0 S (DA,IN,FBIN)=+Y,FBINTOT=0 D CALC^FBAAPIE1,WRT
;
; loop thru Rx and enforce separation of duty
I $$SODPINV^FBAAEPI(FBIN) D G RD1
. W !!,"You cannot process this payment due to separation of duties."
. W !,"You previously entered/edited an associated authorization."
;
D EN1
G RD1
EN1 ;ENTRY FROM THE MAS CLOSE-OUT OPTION (FBAACIE)
;FB*3.5*116 - check for $0 invoice and stop close-out
I +FBINTOT=0 W !!,*7,"Invoice must be greater than 0.00. Invoice cannot be closed out." Q
; end of changes
S FY=$E(DT,1,3)+1700+$S($E(DT,4,5)>9:1,1:0)
S FBAAMPI=$S($D(^FBAA(161.4,1,"FBNUM")):$P(^("FBNUM"),"^",3),1:100),FBAAMPI=$S(FBAAMPI]"":FBAAMPI,1:100),FBSW=1
D BT Q:'$D(FBBN) D WAIT^DICD S (TIC,TAC,TAP,FBSW,FBAATPV)=0 D GO Q
BT W !! S DIC="^FBAA(161.7,",DIC(0)="AEQM",DIC("A")="Select Batch for this Invoice: ",DIC("S")="I $P(^(0),U,3)=""B5""&($G(^(""ST""))=""O"")"
S DIC("W")="W !,"" Obligation #: "",$P(^(0),U,2)" D ^DIC K DIC G Q:X="^"!(X=""),BT:Y<0 S (DA,FBBN)=+Y
I $P(Y,"^",3)'=1 G NOTYOU:$P(^FBAA(161.7,DA,0),"^",5)'=DUZ,NOTPH:$P(^(0),"^",3)'="B5",NOTOP:$P(^("ST"),"^",1)'="O"
S Z(0)=^FBAA(161.7,DA,0),FBAABO=$P(Z(0),"^",2),FBBTA=$P(Z(0),"^",9),FBBIC=$P(Z(0),"^",10)+1,FBBLC=$P(Z(0),"^",11)
G:FBBLC>(FBAAMPI-1) WARN
Q
GO ; HIPAA 5010 - count line items that have 0.00 amount paid
;S FBAAVIN=$P(^FBAA(162.1,FBIN,0),"^",4) F FBJ=0:0 S FBJ=$O(^FBAA(162.1,FBIN,"RX",FBJ)) Q:FBJ'>0 S Y(0)=^FBAA(162.1,FBIN,"RX",FBJ,0) D:$P(Y(0),"^",16)>0 GOT
S FBAAVIN=$P(^FBAA(162.1,FBIN,0),"^",4) F FBJ=0:0 S FBJ=$O(^FBAA(162.1,FBIN,"RX",FBJ)) Q:FBJ'>0 S Y(0)=^FBAA(162.1,FBIN,"RX",FBJ,0) D GOT
D RSET W !!,"Invoice Closed out!!" S FBSW=1
Q Q:'FBSW K J,FBAABO,FBBN,FBIN,TAC,TAP,TIC,DIC,D0,DA,DI,DIE,DQ,DR,IN,FBINTOT,FBAAMPI,FBAATPV,FBAAVIN,FBBIC,FBBLC,FBBTA,FBJ,FY,FBZZ,X,Y,Z,FBSTN Q
GOT S TAC=TAC+$P(Y(0),"^",4),TAP=TAP+$P(Y(0),"^",16),TIC=TIC+1,FBBLC=FBBLC+1,FBSW=0 I $P(Y(0),"^",20)'="R" S FBAATPV=FBAATPV+$P(Y(0),"^",16)
S DIC="^FBAA(162.1,"_FBIN_",""RX"",",DA=FBJ,DA(1)=FBIN,DIE=DIC,DR="13////^S X=FBBN;14////^S X=FBAABO;15////^S X=DT;8////^S X=4"
D ^DIE
I FBBLC>(FBAAMPI-1) D FULL
Q
RSET S DIC="^FBAA(162.1,",DA=FBIN,DIE=DIC,DR="5////^S X=4;6///^S X=TAC;7///^S X=TAP;8///^S X=TIC" D ^DIE
RSET2 S FBBTA=FBBTA+TAP,$P(Z(0),"^",9)=FBBTA,$P(Z(0),"^",10)=FBBIC,$P(Z(0),"^",11)=FBBLC,^FBAA(161.7,FBBN,0)=Z(0)
Q
NOTYOU W !!,*7,"Batch selected established by another user, choose another." G BT
NOTPH W !!,*7,"Batch selected is NOT a Pharmacy type batch, choose another." G BT
NOTOP W !!,*7,"Batch selected not in Open status, choose another." G BT
FULL D RSET2 W !!,*7,"Batch has reached maximum allowable payment entries!",!,"Now openning another batch for you.",! K FBBN
D NEWBT G BT:'$D(FBBN)
Q
WARN W !!,*7,"That Batch already has maximum allowable payment items!" K FBBN G BT
OUT Q
WRT W !,?20,"Invoice Totals: $ "_$J(FBINTOT,1,2) Q
NEWBT ;OPEN NEW BATCH IF NEEDED TO CLOSEOUT INVOICE
S FBSTN=$P(Z(0),"^",8),FBAAOB=$P(Z(0),"^",2) W ! D GETNXB^FBAAUTL W !!,*7,"New Batch to closeout invoice is: ",FBBN
S DIC="^FBAA(161.7,",DLAYGO=161.7,X=FBBN,DIC(0)="LQ",DIC("DR")="1////^S X=FBAAOB;2////^S X=""B5"";3////^S X=DT;4////^S X=DUZ;11////^S X=""O"";16////^S X=FBSTN"
K DD,DO D FILE^DICN K DLAYGO S FBBN=+Y,Z(0)=^FBAA(161.7,FBBN,0)
S FBAAOB=$P(Z(0),"^",2),FBBTA=$P(Z(0),"^",9),FBBIC=$P(Z(0),"^",10)+1,FBBLC=$P(Z(0),"^",11)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAPIP 3712 printed Sep 23, 2025@19:32:13 Page 2
FBAAPIP ;AISC/GRR - ESTABLISH BATCH FOR INVOICE AND CLOSE-OUT ;11/24/2014
+1 ;;3.5;FEE BASIS;**116,154**;JAN 30, 1995;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 DO DT^DICRW
SET FBSW=1
RD1 WRITE !!
SET DIC="^FBAA(162.1,"
SET DIC(0)="AEQM"
SET DIC("S")="I $P(^(0),U,5)=3"
DO ^DIC
KILL DIC
if X="^"!(X="")
GOTO Q
if Y<0
GOTO RD1
SET (DA,IN,FBIN)=+Y
SET FBINTOT=0
DO CALC^FBAAPIE1
DO WRT
+1 ;
+2 ; loop thru Rx and enforce separation of duty
+3 IF $$SODPINV^FBAAEPI(FBIN)
Begin DoDot:1
+4 WRITE !!,"You cannot process this payment due to separation of duties."
+5 WRITE !,"You previously entered/edited an associated authorization."
End DoDot:1
GOTO RD1
+6 ;
+7 DO EN1
+8 GOTO RD1
EN1 ;ENTRY FROM THE MAS CLOSE-OUT OPTION (FBAACIE)
+1 ;FB*3.5*116 - check for $0 invoice and stop close-out
+2 IF +FBINTOT=0
WRITE !!,*7,"Invoice must be greater than 0.00. Invoice cannot be closed out."
QUIT
+3 ; end of changes
+4 SET FY=$EXTRACT(DT,1,3)+1700+$SELECT($EXTRACT(DT,4,5)>9:1,1:0)
+5 SET FBAAMPI=$SELECT($DATA(^FBAA(161.4,1,"FBNUM")):$PIECE(^("FBNUM"),"^",3),1:100)
SET FBAAMPI=$SELECT(FBAAMPI]"":FBAAMPI,1:100)
SET FBSW=1
+6 DO BT
if '$DATA(FBBN)
QUIT
DO WAIT^DICD
SET (TIC,TAC,TAP,FBSW,FBAATPV)=0
DO GO
QUIT
BT WRITE !!
SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQM"
SET DIC("A")="Select Batch for this Invoice: "
SET DIC("S")="I $P(^(0),U,3)=""B5""&($G(^(""ST""))=""O"")"
+1 SET DIC("W")="W !,"" Obligation #: "",$P(^(0),U,2)"
DO ^DIC
KILL DIC
if X="^"!(X="")
GOTO Q
if Y<0
GOTO BT
SET (DA,FBBN)=+Y
+2 IF $PIECE(Y,"^",3)'=1
if $PIECE(^FBAA(161.7,DA,0),"^",5)'=DUZ
GOTO NOTYOU
if $PIECE(^(0),"^",3)'="B5"
GOTO NOTPH
if $PIECE(^("ST"),"^",1)'="O"
GOTO NOTOP
+3 SET Z(0)=^FBAA(161.7,DA,0)
SET FBAABO=$PIECE(Z(0),"^",2)
SET FBBTA=$PIECE(Z(0),"^",9)
SET FBBIC=$PIECE(Z(0),"^",10)+1
SET FBBLC=$PIECE(Z(0),"^",11)
+4 if FBBLC>(FBAAMPI-1)
GOTO WARN
+5 QUIT
GO ; HIPAA 5010 - count line items that have 0.00 amount paid
+1 ;S FBAAVIN=$P(^FBAA(162.1,FBIN,0),"^",4) F FBJ=0:0 S FBJ=$O(^FBAA(162.1,FBIN,"RX",FBJ)) Q:FBJ'>0 S Y(0)=^FBAA(162.1,FBIN,"RX",FBJ,0) D:$P(Y(0),"^",16)>0 GOT
+2 SET FBAAVIN=$PIECE(^FBAA(162.1,FBIN,0),"^",4)
FOR FBJ=0:0
SET FBJ=$ORDER(^FBAA(162.1,FBIN,"RX",FBJ))
if FBJ'>0
QUIT
SET Y(0)=^FBAA(162.1,FBIN,"RX",FBJ,0)
DO GOT
+3 DO RSET
WRITE !!,"Invoice Closed out!!"
SET FBSW=1
Q if 'FBSW
QUIT
KILL J,FBAABO,FBBN,FBIN,TAC,TAP,TIC,DIC,D0,DA,DI,DIE,DQ,DR,IN,FBINTOT,FBAAMPI,FBAATPV,FBAAVIN,FBBIC,FBBLC,FBBTA,FBJ,FY,FBZZ,X,Y,Z,FBSTN
QUIT
GOT SET TAC=TAC+$PIECE(Y(0),"^",4)
SET TAP=TAP+$PIECE(Y(0),"^",16)
SET TIC=TIC+1
SET FBBLC=FBBLC+1
SET FBSW=0
IF $PIECE(Y(0),"^",20)'="R"
SET FBAATPV=FBAATPV+$PIECE(Y(0),"^",16)
+1 SET DIC="^FBAA(162.1,"_FBIN_",""RX"","
SET DA=FBJ
SET DA(1)=FBIN
SET DIE=DIC
SET DR="13////^S X=FBBN;14////^S X=FBAABO;15////^S X=DT;8////^S X=4"
+2 DO ^DIE
+3 IF FBBLC>(FBAAMPI-1)
DO FULL
+4 QUIT
RSET SET DIC="^FBAA(162.1,"
SET DA=FBIN
SET DIE=DIC
SET DR="5////^S X=4;6///^S X=TAC;7///^S X=TAP;8///^S X=TIC"
DO ^DIE
RSET2 SET FBBTA=FBBTA+TAP
SET $PIECE(Z(0),"^",9)=FBBTA
SET $PIECE(Z(0),"^",10)=FBBIC
SET $PIECE(Z(0),"^",11)=FBBLC
SET ^FBAA(161.7,FBBN,0)=Z(0)
+1 QUIT
NOTYOU WRITE !!,*7,"Batch selected established by another user, choose another."
GOTO BT
NOTPH WRITE !!,*7,"Batch selected is NOT a Pharmacy type batch, choose another."
GOTO BT
NOTOP WRITE !!,*7,"Batch selected not in Open status, choose another."
GOTO BT
FULL DO RSET2
WRITE !!,*7,"Batch has reached maximum allowable payment entries!",!,"Now openning another batch for you.",!
KILL FBBN
+1 DO NEWBT
if '$DATA(FBBN)
GOTO BT
+2 QUIT
WARN WRITE !!,*7,"That Batch already has maximum allowable payment items!"
KILL FBBN
GOTO BT
OUT QUIT
WRT WRITE !,?20,"Invoice Totals: $ "_$JUSTIFY(FBINTOT,1,2)
QUIT
NEWBT ;OPEN NEW BATCH IF NEEDED TO CLOSEOUT INVOICE
+1 SET FBSTN=$PIECE(Z(0),"^",8)
SET FBAAOB=$PIECE(Z(0),"^",2)
WRITE !
DO GETNXB^FBAAUTL
WRITE !!,*7,"New Batch to closeout invoice is: ",FBBN
+2 SET DIC="^FBAA(161.7,"
SET DLAYGO=161.7
SET X=FBBN
SET DIC(0)="LQ"
SET DIC("DR")="1////^S X=FBAAOB;2////^S X=""B5"";3////^S X=DT;4////^S X=DUZ;11////^S X=""O"";16////^S X=FBSTN"
+3 KILL DD,DO
DO FILE^DICN
KILL DLAYGO
SET FBBN=+Y
SET Z(0)=^FBAA(161.7,FBBN,0)
+4 SET FBAAOB=$PIECE(Z(0),"^",2)
SET FBBTA=$PIECE(Z(0),"^",9)
SET FBBIC=$PIECE(Z(0),"^",10)+1
SET FBBLC=$PIECE(Z(0),"^",11)
+5 QUIT
