FBAADD ;AISC/GRR - REJECT ENTIRE BATCH ;3/22/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
N FBIENS
RD S DIR(0)="Y",DIR("A")="Are you sure you want to reject all line items in this batch",DIR("B")="NO" D ^DIR K DIR G Q^FBAAVR:$D(DIRUT),RD1^FBAAVR:'Y
I $P(FZ,"^",11)'>0 G NOLINE
D CK1358^FBAAUTL1 G Q^FBAAVR:$D(FBERR)
RR S DIR(0)="F^2:40",DIR("A")="Enter reason for rejecting (2-40 characters)",DIR("?")="Please enter the reason this item was rejected" D ^DIR K DIR G:$D(DIRUT) Q^FBAAVR S FBRR=X
D WAIT^DICD,ALLM:FBTYPE="B3",ALLT:FBTYPE="B2",ALLP:FBTYPE="B5",ALLC:FBTYPE="B9"
W !!,"All items in batch flagged as rejected!!"
G RD2^FBAAVR
;
ALLM 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 S FBIENS=M_","_L_","_K_","_J_"," D REJLN^FBAAVR0
Q
;
ALLT F J=0:0 S J=$O(^FBAAC("AD",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAAC("AD",B,J,K)) Q:K'>0 S FBIENS=K_","_J_"," D REJLN^FBAAVR0
Q
;
ALLP F J=0:0 S J=$O(^FBAA(162.1,"AE",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAA(162.1,"AE",B,J,K)) Q:K'>0 S FBIENS=K_","_J_"," D REJLN^FBAAVR0
Q
;
ALLC F J=0:0 S J=$O(^FBAAI("AC",B,J)) Q:J'>0 S FBIENS=J_"," D REJLN^FBAAVR0
Q
;
NOLINE W $C(7),!!,"Line count of batch is equal zero!",!
G RDD^FBAAVR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAADD 1409 printed Dec 13, 2024@01:55:16 Page 2
FBAADD ;AISC/GRR - REJECT ENTIRE BATCH ;3/22/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 NEW FBIENS
RD SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to reject all line items in this batch"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q^FBAAVR
if 'Y
GOTO RD1^FBAAVR
+1 IF $PIECE(FZ,"^",11)'>0
GOTO NOLINE
+2 DO CK1358^FBAAUTL1
if $DATA(FBERR)
GOTO Q^FBAAVR
RR SET DIR(0)="F^2:40"
SET DIR("A")="Enter reason for rejecting (2-40 characters)"
SET DIR("?")="Please enter the reason this item was rejected"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO Q^FBAAVR
SET FBRR=X
+1 DO WAIT^DICD
if FBTYPE="B3"
DO ALLM
if FBTYPE="B2"
DO ALLT
if FBTYPE="B5"
DO ALLP
if FBTYPE="B9"
DO ALLC
+2 WRITE !!,"All items in batch flagged as rejected!!"
+3 GOTO RD2^FBAAVR
+4 ;
ALLM 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
SET FBIENS=M_","_L_","_K_","_J_","
DO REJLN^FBAAVR0
+1 QUIT
+2 ;
ALLT FOR J=0:0
SET J=$ORDER(^FBAAC("AD",B,J))
if J'>0
QUIT
FOR K=0:0
SET K=$ORDER(^FBAAC("AD",B,J,K))
if K'>0
QUIT
SET FBIENS=K_","_J_","
DO REJLN^FBAAVR0
+1 QUIT
+2 ;
ALLP FOR J=0:0
SET J=$ORDER(^FBAA(162.1,"AE",B,J))
if J'>0
QUIT
FOR K=0:0
SET K=$ORDER(^FBAA(162.1,"AE",B,J,K))
if K'>0
QUIT
SET FBIENS=K_","_J_","
DO REJLN^FBAAVR0
+1 QUIT
+2 ;
ALLC FOR J=0:0
SET J=$ORDER(^FBAAI("AC",B,J))
if J'>0
QUIT
SET FBIENS=J_","
DO REJLN^FBAAVR0
+1 QUIT
+2 ;
NOLINE WRITE $CHAR(7),!!,"Line count of batch is equal zero!",!
+1 GOTO RDD^FBAAVR
