- 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 Feb 18, 2025@23:23:39 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
