FBAAVR2 ;AISC/GRR,SAB - FINALIZE BATCH (CONT) ;3/26/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
DELM ; specify local rejects for batch type B3
; select patient
S J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AC"",B,+Y))")
Q:'J
K QQ
S (QQ,FBAAOUT)=0 W @IOF D HED^FBAACCB
F K=0:0 S K=$O(^FBAAC("AC",B,J,K)) Q:K'>0!(FBAAOUT) F L=0:0 S L=$O(^FBAAC("AC",B,J,K,L)) Q:L'>0!(FBAAOUT) F M=0:0 S M=$O(^FBAAC("AC",B,J,K,L,M)) Q:M'>0!(FBAAOUT) D WRITM
RL1 S DIR(0)="Y",DIR("A")="Want all line items rejected for this patient",DIR("B")="YES" D ^DIR K DIR G DELM:$D(DIRUT),LOOP:Y
RL S DIR(0)="N^1:"_QQ,DIR("A")="Reject which line item" D ^DIR K DIR G DELM:X=""!$D(DIRUT) S HX=X
I '$D(QQ(HX)) W !,*7,"You already rejected that one!!" G RL
RJT S DIR(0)="Y",DIR("A")="Are you sure you want to reject item number: "_HX,DIR("B")="NO" D ^DIR K DIR G RL:$D(DIRUT)!'Y
S FBIENS=$P(QQ(HX),"^",4)_","_$P(QQ(HX),"^",3)_","_$P(QQ(HX),"^",2)_","_$P(QQ(HX),"^",1)_","
RDR1 S DIR(0)="F^2:40",DIR("A")="Enter reason for rejecting" D ^DIR K DIR W:$D(DIRUT) !!,"Required Response!!" G:$D(DIRUT) RDR1 S FBRR=X
D REJLN^FBAAVR0
RDMORE S DIR(0)="Y",DIR("A")="Item rejected. Want to reject another",DIR("B")="YES"
D ^DIR K DIR Q:$D(DIRUT) G RL:Y,DELM
;
WRITM S QQ=QQ+1,QQ(QQ)=J_"^"_K_"^"_L_"^"_M D SET^FBAACCB Q
;
LOOP ; reject all lines for patient
S DIR(0)="F^2:40",DIR("A")="Reason for rejecting" D ^DIR K DIR
G:$D(DIRUT) DELM
S FBRR=X
F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0 S FBIENS=$P(QQ(HX),"^",4)_","_$P(QQ(HX),"^",3)_","_$P(QQ(HX),"^",2)_","_$P(QQ(HX),"^",1)_"," D REJLN^FBAAVR0
W !,"...DONE!"
G DELM
;
SPLIT ; reject all lines on split invoices
S DIR(0)="F^2:40",DIR("A")="Reason for rejecting" D ^DIR K DIR
Q:$D(DIRUT)
S FBRR=X
S FBIENS="" F S FBIENS=$O(FBLNLST(FBIENS)) Q:FBIENS="" D REJLN^FBAAVR0
W !,"...DONE!"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAVR2 1925 printed Dec 13, 2024@01:57:13 Page 2
FBAAVR2 ;AISC/GRR,SAB - FINALIZE BATCH (CONT) ;3/26/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 ;
DELM ; specify local rejects for batch type B3
+1 ; select patient
+2 SET J=$$ASKVET^FBAAUTL1("I $D(^FBAAC(""AC"",B,+Y))")
+3 if 'J
QUIT
+4 KILL QQ
+5 SET (QQ,FBAAOUT)=0
WRITE @IOF
DO HED^FBAACCB
+6 FOR K=0:0
SET K=$ORDER(^FBAAC("AC",B,J,K))
if K'>0!(FBAAOUT)
QUIT
FOR L=0:0
SET L=$ORDER(^FBAAC("AC",B,J,K,L))
if L'>0!(FBAAOUT)
QUIT
FOR M=0:0
SET M=$ORDER(^FBAAC("AC",B,J,K,L,M))
if M'>0!(FBAAOUT)
QUIT
DO WRITM
RL1 SET DIR(0)="Y"
SET DIR("A")="Want all line items rejected for this patient"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO DELM
if Y
GOTO LOOP
RL SET DIR(0)="N^1:"_QQ
SET DIR("A")="Reject which line item"
DO ^DIR
KILL DIR
if X=""!$DATA(DIRUT)
GOTO DELM
SET HX=X
+1 IF '$DATA(QQ(HX))
WRITE !,*7,"You already rejected that one!!"
GOTO RL
RJT SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to reject item number: "_HX
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)!'Y
GOTO RL
+1 SET FBIENS=$PIECE(QQ(HX),"^",4)_","_$PIECE(QQ(HX),"^",3)_","_$PIECE(QQ(HX),"^",2)_","_$PIECE(QQ(HX),"^",1)_","
RDR1 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 RDR1
SET FBRR=X
+1 DO REJLN^FBAAVR0
RDMORE SET DIR(0)="Y"
SET DIR("A")="Item rejected. Want to reject another"
SET DIR("B")="YES"
+1 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
if Y
GOTO RL
GOTO DELM
+2 ;
WRITM SET QQ=QQ+1
SET QQ(QQ)=J_"^"_K_"^"_L_"^"_M
DO SET^FBAACCB
QUIT
+1 ;
LOOP ; reject all lines for patient
+1 SET DIR(0)="F^2:40"
SET DIR("A")="Reason for rejecting"
DO ^DIR
KILL DIR
+2 if $DATA(DIRUT)
GOTO DELM
+3 SET FBRR=X
+4 FOR HX=0:0
SET HX=$ORDER(QQ(HX))
if HX'>0
QUIT
SET FBIENS=$PIECE(QQ(HX),"^",4)_","_$PIECE(QQ(HX),"^",3)_","_$PIECE(QQ(HX),"^",2)_","_$PIECE(QQ(HX),"^",1)_","
DO REJLN^FBAAVR0
+5 WRITE !,"...DONE!"
+6 GOTO DELM
+7 ;
SPLIT ; reject all lines on split invoices
+1 SET DIR(0)="F^2:40"
SET DIR("A")="Reason for rejecting"
DO ^DIR
KILL DIR
+2 if $DATA(DIRUT)
QUIT
+3 SET FBRR=X
+4 SET FBIENS=""
FOR
SET FBIENS=$ORDER(FBLNLST(FBIENS))
if FBIENS=""
QUIT
DO REJLN^FBAAVR0
+5 WRITE !,"...DONE!"
+6 QUIT
