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 ---[H[J[2J[HFBAAVR1 3084 printed Dec 13, 2024@01:57:12 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
