FBAAVR.m

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 ---FBAAVR   4645     printed  Mar 13, 2025@21:01:53                                                                                                                                                                                                      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