FBAAVR ;AISC/GRR,SAB - FINALIZE BATCH ;4/16/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
S Q="",$P(Q,"=",80)="=",IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS
D DT^DICRW
I '$D(^XUSEC("FBAAREJECT",DUZ)),'$D(^XUSEC("FBAAFINANCE")) W !!,*7,"Sorry, you must hold security key FBAAREJECT or FBAAFINANCE!" G Q
;
BT ; select batch
S FBINTOT=0 K QQ W !!
K DIC S DIC="^FBAA(161.7,",DIC(0)="AEQ",DIC("S")="I $G(^(""ST""))=""F"""
D ^DIC K DIC("S") G Q:X="^"!(X=""),BT:Y<0
L +^FBAA(161.7,+Y):$G(DILOCKTM,3)
I '$T W !,"Another user is editing this batch. Try again later." G Q
S FBN=+Y
I $G(^FBAA(161.7,FBN,"ST"))'="F" W !,$C(7),"Batch status must be CENTRAL FEE ACCEPTED!" G DONE
S FZ=^FBAA(161.7,FBN,0),FBTYPE=$P(FZ,"^",3)
S FBAAB=$P(FZ,"^"),FBAAON=$P(FZ,"^",2),FBAAOB=$P(FZ,"^",8)_"-"_FBAAON
I FBTYPE="B9",$P(FZ,"^",15)="" S FBCNH=1
S (FBRFLAG,FBAARA)=0
;
; display batch
S DIC="^FBAA(161.7,",DA=FBN,DR="0:1;ST" W !! D EN^DIQ
;
; check for split invoice
I FBTYPE="B3" D CHKSPLT^FBAAVR3
;
BTL S B=FBN S DIR(0)="Y",DIR("A")="Want line items listed",DIR("B")="NO" D ^DIR K DIR G Q:$D(DIRUT) W:Y @IOF D:Y LIST^FBAACCB:FBTYPE="B3",LISTP^FBAACCB:FBTYPE="B5",LISTT^FBAACCB0:FBTYPE="B2",LISTC^FBAACCB1:FBTYPE="B9"
;
RD0 ; local reject functionality
I '$D(^XUSEC("FBAAREJECT",DUZ)) W !,"Skipping reject function because key not held." G RDD
;
S DIR(0)="Y",DIR("A")="Want to reject the entire Batch",DIR("B")="NO",DIR("?")="'Yes' will flag all payment items in batch as rejected, 'No' will prompt for rejection of specific line items." D ^DIR K DIR G Q:$D(DIRUT),^FBAADD:Y
;
I FBTYPE="B3",$D(FBLNLST) D G Q:$D(DIRUT),SPLIT^FBAAVR2:Y
. S DIR(0)="Y"
. S DIR("A")="Want to reject all line items on split invoices"
. S DIR("B")="NO"
. S DIR("?")="'Yes' will flag all payment items on split invoices as rejected, 'No' will prompt for rejection of specific line items."
. D ^DIR K DIR
;
RD1 S DIR(0)="Y",DIR("A")="Want to reject any line items",DIR("B")="NO" D ^DIR K DIR G Q:$D(DIRUT)
I 'Y G RDD
; answered yes to reject line items
I $P(FZ,U,11)'>0 G NOLINE^FBAADD
D CK1358^FBAAUTL1 G Q:$D(FBERR)
D DELC^FBAAVR0:FBTYPE="B9"
D DELT^FBAAVR1:FBTYPE="B2"
D DELP^FBAAVR1:FBTYPE="B5"
D DELM^FBAAVR2:FBTYPE="B3"
;
RD2 ; update obligation for rejected lines that are posted by batch
I FBRFLAG D
. N FBX
. S FBRFLAG=0
. Q:FBAARA'>0
. S FBX=$$POSTBAT^FB1358(FBN,FBAARA,"R")
. I 'FBX D
. . W !,"Error posting $"_$FN(FBAARA,",",2)_" to 1358 for batch "_FBAAB
. . W !," "_$P(FBX,"^",2)
;
; display batch
S DIC="^FBAA(161.7,",DA=FBN,DR="0:1;ST" W !! D EN^DIQ
;
RDD ; finalize batch functionality
I '$D(^XUSEC("FBAAFINANCE",DUZ)) W !,"Skipping finalize function because key not held." G DONE
;
; enforce segregation of duties
I $P(FZ,U,7)=DUZ W $C(7),!,"You released this batch. Per segregation of duties you cannot finalize it." G DONE
;
RDD1 ; ask if batch should be finalized
S DIR(0)="Y",DIR("A")="Do you want to Finalize Batch as Correct"
S DIR("B")="NO"
D ^DIR K DIR G Q:$D(DIRUT)
I 'Y W !!,"Batch has NOT been Finalized!",$C(7) G DONE
;
; generate voucher batch message
S FBX=$$VBMSG^FBAAVR5(FBN)
I FBX W !,"Voucher Batch message # "_FBX_" sent to Central Fee."
I 'FBX D G DONE
. W !,"Error occurred during creation of voucher batch message."
. W !," ",$P(FBX,U,2)
. W !!,"Batch has NOT been Finalized!",$C(7)
;
; finalize batch
; update line items
D MEDV:FBTYPE="B3",VCHNH^FBAAVR0:FBTYPE="B9"
; update batch file
S DA=FBN,DIE="^FBAA(161.7,"
S DR="13////^S X=DT;14////^S X=DUZ;11////^S X=""V"";20////^S X=1"
D ^DIE K DIE,DA
W !!," Batch has been Finalized!"
;
DONE ;
D Q
G FBAAVR
;
Q ; clean-up
I $G(FBN) L -^FBAA(161.7,FBN)
K B,J,K,L,M,X,Y,Z,DIC,ERR,FBN,FBAAOUT,FBAC,FBAP,FBFD,FBPDT,FBSC,FBTD,FBVP,POP,FBRFLAG,Q,QQ,A,A1,A2,DO,DA,DL,DR,DRX,DX,FBAAAP,FBAACB,FBAACPT,FBAAON,FBAARA,FBINTOT,FBIN,FBRR,FBTYPE,FZ,HX,I,P3,P4,S,V,VAL,VID,XY,ZS,FBAAB,FBAAOB,DIRUT
K FBAAON,FBCOMM,FBERR,FBI,FBLIST,PRCS("TYPE"),FBLISTC,FBINOLD,FBDX,FBK,FBL,FBPROC,FBCNH,FBAAMT,FBII78,FBLNLST
Q
;
MEDV ; set DATE FINALIZED for line items in batch type B3
F J=0:0 S J=$O(^FBAAC("AC",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAAC("AC",B,J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAAC("AC",B,J,K,L)) Q:L'>0 F M=0:0 S M=$O(^FBAAC("AC",B,J,K,L,M)) Q:M'>0 D SETXFR
Q
SETXFR I '$D(^FBAAC(J,1,K,1,L,1,M,"FBREJ")),$D(^FBAAC(J,1,K,1,L,1,M,0)) S DA(3)=J,DA(2)=K,DA(1)=L,DA=M,DIE="^FBAAC(DA(3),1,DA(2),1,DA(1),1,",DR="5///^S X=DT" D ^DIE K DIE,DA,DR
Q
;
;FBAAVR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAVR 4645 printed Apr 09, 2024@21:01:54 Page 2
FBAAVR ;AISC/GRR,SAB - FINALIZE BATCH ;4/16/2012
+1 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET Q=""
SET $PIECE(Q,"=",80)="="
SET IOP=$SELECT($DATA(ION):ION,1:"HOME")
DO ^%ZIS
+4 DO DT^DICRW
+5 IF '$DATA(^XUSEC("FBAAREJECT",DUZ))
IF '$DATA(^XUSEC("FBAAFINANCE"))
WRITE !!,*7,"Sorry, you must hold security key FBAAREJECT or FBAAFINANCE!"
GOTO Q
+6 ;
BT ; select batch
+1 SET FBINTOT=0
KILL QQ
WRITE !!
+2 KILL DIC
SET DIC="^FBAA(161.7,"
SET DIC(0)="AEQ"
SET DIC("S")="I $G(^(""ST""))=""F"""
+3 DO ^DIC
KILL DIC("S")
if X="^"!(X="")
GOTO Q
if Y<0
GOTO BT
+4 LOCK +^FBAA(161.7,+Y):$GET(DILOCKTM,3)
+5 IF '$TEST
WRITE !,"Another user is editing this batch. Try again later."
GOTO Q
+6 SET FBN=+Y
+7 IF $GET(^FBAA(161.7,FBN,"ST"))'="F"
WRITE !,$CHAR(7),"Batch status must be CENTRAL FEE ACCEPTED!"
GOTO DONE
+8 SET FZ=^FBAA(161.7,FBN,0)
SET FBTYPE=$PIECE(FZ,"^",3)
+9 SET FBAAB=$PIECE(FZ,"^")
SET FBAAON=$PIECE(FZ,"^",2)
SET FBAAOB=$PIECE(FZ,"^",8)_"-"_FBAAON
+10 IF FBTYPE="B9"
IF $PIECE(FZ,"^",15)=""
SET FBCNH=1
+11 SET (FBRFLAG,FBAARA)=0
+12 ;
+13 ; display batch
+14 SET DIC="^FBAA(161.7,"
SET DA=FBN
SET DR="0:1;ST"
WRITE !!
DO EN^DIQ
+15 ;
+16 ; check for split invoice
+17 IF FBTYPE="B3"
DO CHKSPLT^FBAAVR3
+18 ;
BTL SET B=FBN
SET DIR(0)="Y"
SET DIR("A")="Want line items listed"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
if Y
WRITE @IOF
if Y
if FBTYPE="B3"
DO LIST^FBAACCB
if FBTYPE="B5"
DO LISTP^FBAACCB
if FBTYPE="B2"
DO LISTT^FBAACCB0
if FBTYPE="B9"
DO LISTC^FBAACCB1
+1 ;
RD0 ; local reject functionality
+1 IF '$DATA(^XUSEC("FBAAREJECT",DUZ))
WRITE !,"Skipping reject function because key not held."
GOTO RDD
+2 ;
+3 SET DIR(0)="Y"
SET DIR("A")="Want to reject the entire Batch"
SET DIR("B")="NO"
SET DIR("?")="'Yes' will flag all payment items in batch as rejected, 'No' will prompt for rejection of specific line items."
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
if Y
GOTO ^FBAADD
+4 ;
+5 IF FBTYPE="B3"
IF $DATA(FBLNLST)
Begin DoDot:1
+6 SET DIR(0)="Y"
+7 SET DIR("A")="Want to reject all line items on split invoices"
+8 SET DIR("B")="NO"
+9 SET DIR("?")="'Yes' will flag all payment items on split invoices as rejected, 'No' will prompt for rejection of specific line items."
+10 DO ^DIR
KILL DIR
End DoDot:1
if $DATA(DIRUT)
GOTO Q
if Y
GOTO SPLIT^FBAAVR2
+11 ;
RD1 SET DIR(0)="Y"
SET DIR("A")="Want to reject any line items"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
+1 IF 'Y
GOTO RDD
+2 ; answered yes to reject line items
+3 IF $PIECE(FZ,U,11)'>0
GOTO NOLINE^FBAADD
+4 DO CK1358^FBAAUTL1
if $DATA(FBERR)
GOTO Q
+5 if FBTYPE="B9"
DO DELC^FBAAVR0
+6 if FBTYPE="B2"
DO DELT^FBAAVR1
+7 if FBTYPE="B5"
DO DELP^FBAAVR1
+8 if FBTYPE="B3"
DO DELM^FBAAVR2
+9 ;
RD2 ; update obligation for rejected lines that are posted by batch
+1 IF FBRFLAG
Begin DoDot:1
+2 NEW FBX
+3 SET FBRFLAG=0
+4 if FBAARA'>0
QUIT
+5 SET FBX=$$POSTBAT^FB1358(FBN,FBAARA,"R")
+6 IF 'FBX
Begin DoDot:2
+7 WRITE !,"Error posting $"_$FNUMBER(FBAARA,",",2)_" to 1358 for batch "_FBAAB
+8 WRITE !," "_$PIECE(FBX,"^",2)
End DoDot:2
End DoDot:1
+9 ;
+10 ; display batch
+11 SET DIC="^FBAA(161.7,"
SET DA=FBN
SET DR="0:1;ST"
WRITE !!
DO EN^DIQ
+12 ;
RDD ; finalize batch functionality
+1 IF '$DATA(^XUSEC("FBAAFINANCE",DUZ))
WRITE !,"Skipping finalize function because key not held."
GOTO DONE
+2 ;
+3 ; enforce segregation of duties
+4 IF $PIECE(FZ,U,7)=DUZ
WRITE $CHAR(7),!,"You released this batch. Per segregation of duties you cannot finalize it."
GOTO DONE
+5 ;
RDD1 ; ask if batch should be finalized
+1 SET DIR(0)="Y"
SET DIR("A")="Do you want to Finalize Batch as Correct"
+2 SET DIR("B")="NO"
+3 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q
+4 IF 'Y
WRITE !!,"Batch has NOT been Finalized!",$CHAR(7)
GOTO DONE
+5 ;
+6 ; generate voucher batch message
+7 SET FBX=$$VBMSG^FBAAVR5(FBN)
+8 IF FBX
WRITE !,"Voucher Batch message # "_FBX_" sent to Central Fee."
+9 IF 'FBX
Begin DoDot:1
+10 WRITE !,"Error occurred during creation of voucher batch message."
+11 WRITE !," ",$PIECE(FBX,U,2)
+12 WRITE !!,"Batch has NOT been Finalized!",$CHAR(7)
End DoDot:1
GOTO DONE
+13 ;
+14 ; finalize batch
+15 ; update line items
+16 if FBTYPE="B3"
DO MEDV
if FBTYPE="B9"
DO VCHNH^FBAAVR0
+17 ; update batch file
+18 SET DA=FBN
SET DIE="^FBAA(161.7,"
+19 SET DR="13////^S X=DT;14////^S X=DUZ;11////^S X=""V"";20////^S X=1"
+20 DO ^DIE
KILL DIE,DA
+21 WRITE !!," Batch has been Finalized!"
+22 ;
DONE ;
+1 DO Q
+2 GOTO FBAAVR
+3 ;
Q ; clean-up
+1 IF $GET(FBN)
LOCK -^FBAA(161.7,FBN)
+2 KILL B,J,K,L,M,X,Y,Z,DIC,ERR,FBN,FBAAOUT,FBAC,FBAP,FBFD,FBPDT,FBSC,FBTD,FBVP,POP,FBRFLAG,Q,QQ,A,A1,A2,DO,DA,DL,DR,DRX,DX,FBAAAP,FBAACB,FBAACPT,FBAAON,FBAARA,FBINTOT,FBIN,FBRR,FBTYPE,FZ,HX,I,P3,P4,S,V,VAL,VID,XY,ZS,FBAAB,FBAAOB,DIRUT
+3 KILL FBAAON,FBCOMM,FBERR,FBI,FBLIST,PRCS("TYPE"),FBLISTC,FBINOLD,FBDX,FBK,FBL,FBPROC,FBCNH,FBAAMT,FBII78,FBLNLST
+4 QUIT
+5 ;
MEDV ; set DATE FINALIZED for line items in batch type B3
+1 FOR J=0:0
SET J=$ORDER(^FBAAC("AC",B,J))
if J'>0
QUIT
FOR K=0:0
SET K=$ORDER(^FBAAC("AC",B,J,K))
if K'>0
QUIT
FOR L=0:0
SET L=$ORDER(^FBAAC("AC",B,J,K,L))
if L'>0
QUIT
FOR M=0:0
SET M=$ORDER(^FBAAC("AC",B,J,K,L,M))
if M'>0
QUIT
DO SETXFR
+2 QUIT
SETXFR IF '$DATA(^FBAAC(J,1,K,1,L,1,M,"FBREJ"))
IF $DATA(^FBAAC(J,1,K,1,L,1,M,0))
SET DA(3)=J
SET DA(2)=K
SET DA(1)=L
SET DA=M
SET DIE="^FBAAC(DA(3),1,DA(2),1,DA(1),1,"
SET DR="5///^S X=DT"
DO ^DIE
KILL DIE,DA,DR
+1 QUIT
+2 ;
+3 ;FBAAVR
