FBAAVR1.m

FBAAVR1 ;AISC/GRR,SAB - FEE BASIS VOUCHER AUDIT DELETE AN ITEM ;4/30/2012

 ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 Q

 ;

DELT ; specify local rejects for batch type B2 (travel)

 N FBIENS

 ; select patient

 S J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AD"",B,+Y))")

 Q:'J

 K QQ

 S (QQ,FBAAOUT)=0 W @IOF D HEDP^FBAACCB0

 F K=0:0 S K=$O(^FBAAC("AD",B,J,K)) Q:K'>0!(FBAAOUT)  S QQ=QQ+1,QQ(QQ)=J_"^"_K S Y(0)=^FBAAC(J,3,K,0) D SETT^FBAACCB0

 ;

RLT1 S DIR(0)="Y",DIR("A")="Reject all line items for this patient",DIR("B")="YES" D ^DIR K DIR G DELT:$D(DIRUT),LOOPT:Y

RLT ; select a line to reject

 S DIR(0)="NO^1:"_QQ,DIR("A")="Reject which line item" D ^DIR K DIR G DELT:X=""!$D(DIRUT) S HX=X

 I '$D(QQ(HX)) W !!,*7,"You just deleted that one!!" G RLT

RASK S DIR(0)="Y",DIR("A")="Are you sure you want to reject line item number: "_HX,DIR("B")="NO" D ^DIR K DIR G RLT:$D(DIRUT)!'Y

 S FBIENS=$P(QQ(HX),"^",2)_","_$P(QQ(HX),"^",1)_","

RDR2 S DIR(0)="F^2:40",DIR("A")="Enter reason for rejecting" D ^DIR K DIR W:$D(DIRUT) !!,"Required Response!!" G:$D(DIRUT) RDR2 S FBRR=X

 D REJLN^FBAAVR0

RDMORT S DIR(0)="Y",DIR("A")="Item Rejected!  Want to reject another",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT)  G RLT:Y

 G DELT

 ;

LOOPT ; reject all lines for patient in batch type B2 (travel)

 S DIR(0)="F^2:40",DIR("A")="Reason for Rejecting" D ^DIR K DIR

 G:$D(DIRUT) DELT

 S FBRR=X

 F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0  S FBIENS=$P(QQ(HX),"^",2)_","_$P(QQ(HX),"^",1)_"," D REJLN^FBAAVR0

 W !,"...DONE!"

 G DELT

 ;

DELP ; specify local rejects for batch type B5 (pharmacy)

 N FBIENS,W1,W2

 ; select patient

 S DFN=$$ASKVET^FBAAUTL1("I $D(^FBAA(162.1,""AJ"",B,+Y))")

 Q:'DFN

 K QQ

 S (FBAAOUT,QQ)=0 W @IOF D HED^FBAACCB

 F W1=0:0 S W1=$O(^FBAA(162.1,"AJ",B,DFN,W1)) Q:W1'>0!(FBAAOUT)  F W2=0:0 S W2=$O(^FBAA(162.1,"AJ",B,DFN,W1,W2)) Q:W2'>0!(FBAAOUT)  S (A,FBIN)=W1,B2=W2,QQ=QQ+1,QQ(QQ)=A_"^"_B2 S Z(0)=^FBAA(162.1,A,"RX",B2,0) D SETV^FBAACCB0,MORE^FBAACCB1

 ;

RLP1 S DIR(0)="Y",DIR("A")="Reject all line items for this patient",DIR("B")="YES" D ^DIR K DIR G DELP:$D(DIRUT),LOOPP:Y

 ;

RLP ; select a line to reject

 S DIR(0)="NO^1:"_QQ,DIR("A")="Reject which line item" D ^DIR K DIR G DELP:X=""!$D(DIRUT) S HX=X

 I '$D(QQ(HX)) W !!,*7,"You just did that one!" G RLP

RLI S DIR(0)="Y",DIR("A")="Are you sure you want to reject line item number: "_HX,DIR("B")="NO" D ^DIR K DIR G RLP:$D(DIRUT)!'Y

 S FBIENS=$P(QQ(HX),"^",2)_","_$P(QQ(HX),"^",1)_","

RDR3 S DIR(0)="F^2:40",DIR("A")="Enter reason for rejecting" D ^DIR K DIR

 G:$D(DIRUT) RLP

 S FBRR=X

 D REJLN^FBAAVR0

RDMORP S DIR(0)="Y",DIR("A")="Item rejected. Want to reject another",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT)  G RLP:Y

 G DELP

 ;

LOOPP ; reject all lines for patient in batch type B5 (pharmacy)

 S DIR(0)="F^2:40",DIR("A")="Reason for Rejecting" D ^DIR K DIR

 G:$D(DIRUT) DELP

 S FBRR=X

 F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0  S FBIENS=$P(QQ(HX),"^",2)_","_$P(QQ(HX),"^",1)_"," D REJLN^FBAAVR0

 W !,"...DONE!"

 G DELP

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---FBAAVR1   3084     printed  Mar 13, 2025@21:01:54                                                                                                                                                                                                     Page 2

FBAAVR1   ;AISC/GRR,SAB - FEE BASIS VOUCHER AUDIT DELETE AN ITEM ;4/30/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        QUIT 

 +4       ;

DELT      ; specify local rejects for batch type B2 (travel)

 +1        NEW FBIENS

 +2       ; select patient

 +3        SET J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AD"",B,+Y))")

 +4        if 'J

               QUIT 

 +5        KILL QQ

 +6        SET (QQ,FBAAOUT)=0

           WRITE @IOF

           DO HEDP^FBAACCB0

 +7        FOR K=0:0

               SET K=$ORDER(^FBAAC("AD",B,J,K))

               if K'>0!(FBAAOUT)

                   QUIT 

               SET QQ=QQ+1

               SET QQ(QQ)=J_"^"_K

               SET Y(0)=^FBAAC(J,3,K,0)

               DO SETT^FBAACCB0

 +8       ;

RLT1       SET DIR(0)="Y"

           SET DIR("A")="Reject all line items for this patient"

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO DELT

           if Y

               GOTO LOOPT

RLT       ; select a line to reject

 +1        SET DIR(0)="NO^1:"_QQ

           SET DIR("A")="Reject which line item"

           DO ^DIR

           KILL DIR

           if X=""!$DATA(DIRUT)

               GOTO DELT

           SET HX=X

 +2        IF '$DATA(QQ(HX))

               WRITE !!,*7,"You just deleted that one!!"

               GOTO RLT

RASK       SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to reject line item number: "_HX

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!'Y

               GOTO RLT

 +1        SET FBIENS=$PIECE(QQ(HX),"^",2)_","_$PIECE(QQ(HX),"^",1)_","

RDR2       SET DIR(0)="F^2:40"

           SET DIR("A")="Enter reason for rejecting"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               WRITE !!,"Required Response!!"

           if $DATA(DIRUT)

               GOTO RDR2

           SET FBRR=X

 +1        DO REJLN^FBAAVR0

RDMORT     SET DIR(0)="Y"

           SET DIR("A")="Item Rejected!  Want to reject another"

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT 

           if Y

               GOTO RLT

 +1        GOTO DELT

 +2       ;

LOOPT     ; reject all lines for patient in batch type B2 (travel)

 +1        SET DIR(0)="F^2:40"

           SET DIR("A")="Reason for Rejecting"

           DO ^DIR

           KILL DIR

 +2        if $DATA(DIRUT)

               GOTO DELT

 +3        SET FBRR=X

 +4        FOR HX=0:0

               SET HX=$ORDER(QQ(HX))

               if HX'>0

                   QUIT 

               SET FBIENS=$PIECE(QQ(HX),"^",2)_","_$PIECE(QQ(HX),"^",1)_","

               DO REJLN^FBAAVR0

 +5        WRITE !,"...DONE!"

 +6        GOTO DELT

 +7       ;

DELP      ; specify local rejects for batch type B5 (pharmacy)

 +1        NEW FBIENS,W1,W2

 +2       ; select patient

 +3        SET DFN=$$ASKVET^FBAAUTL1("I $D(^FBAA(162.1,""AJ"",B,+Y))")

 +4        if 'DFN

               QUIT 

 +5        KILL QQ

 +6        SET (FBAAOUT,QQ)=0

           WRITE @IOF

           DO HED^FBAACCB

 +7        FOR W1=0:0

               SET W1=$ORDER(^FBAA(162.1,"AJ",B,DFN,W1))

               if W1'>0!(FBAAOUT)

                   QUIT 

               FOR W2=0:0

                   SET W2=$ORDER(^FBAA(162.1,"AJ",B,DFN,W1,W2))

                   if W2'>0!(FBAAOUT)

                       QUIT 

                   SET (A,FBIN)=W1

                   SET B2=W2

                   SET QQ=QQ+1

                   SET QQ(QQ)=A_"^"_B2

                   SET Z(0)=^FBAA(162.1,A,"RX",B2,0)

                   DO SETV^FBAACCB0

                   DO MORE^FBAACCB1

 +8       ;

RLP1       SET DIR(0)="Y"

           SET DIR("A")="Reject all line items for this patient"

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               GOTO DELP

           if Y

               GOTO LOOPP

 +1       ;

RLP       ; select a line to reject

 +1        SET DIR(0)="NO^1:"_QQ

           SET DIR("A")="Reject which line item"

           DO ^DIR

           KILL DIR

           if X=""!$DATA(DIRUT)

               GOTO DELP

           SET HX=X

 +2        IF '$DATA(QQ(HX))

               WRITE !!,*7,"You just did that one!"

               GOTO RLP

RLI        SET DIR(0)="Y"

           SET DIR("A")="Are you sure you want to reject line item number: "_HX

           SET DIR("B")="NO"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)!'Y

               GOTO RLP

 +1        SET FBIENS=$PIECE(QQ(HX),"^",2)_","_$PIECE(QQ(HX),"^",1)_","

RDR3       SET DIR(0)="F^2:40"

           SET DIR("A")="Enter reason for rejecting"

           DO ^DIR

           KILL DIR

 +1        if $DATA(DIRUT)

               GOTO RLP

 +2        SET FBRR=X

 +3        DO REJLN^FBAAVR0

RDMORP     SET DIR(0)="Y"

           SET DIR("A")="Item rejected. Want to reject another"

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

           if $DATA(DIRUT)

               QUIT 

           if Y

               GOTO RLP

 +1        GOTO DELP

 +2       ;

LOOPP     ; reject all lines for patient in batch type B5 (pharmacy)

 +1        SET DIR(0)="F^2:40"

           SET DIR("A")="Reason for Rejecting"

           DO ^DIR

           KILL DIR

 +2        if $DATA(DIRUT)

               GOTO DELP

 +3        SET FBRR=X

 +4        FOR HX=0:0

               SET HX=$ORDER(QQ(HX))

               if HX'>0

                   QUIT 

               SET FBIENS=$PIECE(QQ(HX),"^",2)_","_$PIECE(QQ(HX),"^",1)_","

               DO REJLN^FBAAVR0

 +5        WRITE !,"...DONE!"

 +6        GOTO DELP