FBAAVR0 ;AISC/GRR,SAB - REJECT ITEMS ;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
;
VCHNH ; set DATE FINALIZED for batch type B9 line items
F J=0:0 S J=$O(^FBAAI("AC",B,J)) Q:J'>0 I '$D(^FBAAI(J,"FBREJ")),$D(^FBAAI(J,0)) S DA=J,DIE="^FBAAI(",DR="19////^S X=DT" D ^DIE
K DIE,DA
Q
;
DELC ; specify local rejects for batch type B9
N FBIENS
; select patient
S FBDFN=$$ASKVET^FBAAUTL1("I $D(^FBAAI(""AE"",B,+Y))")
Q:'FBDFN
K QQ
S (QQ,FBAAOUT)=0 W @IOF D HEDC^FBAACCB1 F I=0:0 S I=$O(^FBAAI("AE",B,FBDFN,I)) Q:I'>0!(FBAAOUT) I $D(^FBAAI(I,0)) S Z(0)=^(0),FBI=I D WRITC
;
RL S DIR(0)="Y",DIR("A")="Want all line items rejected for this patient",DIR("B")="YES" D ^DIR K DIR G DELC:$D(DIRUT),LOOP:Y
RL1 S DIR(0)="NO^1:"_QQ,DIR("A")="Reject which line item" D ^DIR K DIR G DELC:X=""!$D(DIRUT) S HX=X
I '$D(QQ(HX)) W !,*7,"You already rejected that one!!" G RL1
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 RL1:$D(DIRUT)!'Y
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
S FBIENS=QQ(HX)_"," D REJLN
RDMORE S DIR(0)="Y",DIR("A")="Item rejected. Want to reject another",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT) G RL1:Y
Q
;
WRITC S QQ=QQ+1,QQ(QQ)=I D CMORE^FBAACCB1
Q
;
LOOP S DIR(0)="F^2:40",DIR("A")="Reason for rejecting" D ^DIR K DIR W:$D(DIRUT) !!,"Required Response!!" G:$D(DIRUT) LOOP S FBRR=X
F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0 S FBIENS=QQ(HX)_"," D REJLN
W !,"...DONE!"
G DELC
;
REJLN ; flag line item as rejected
; input
; FBN - batch IEN
; FBTYPE - batch type
; FZ - zero node of batch (file 161.7)
; FBIENS - iens of line item
; FBRR - reject reason
; FBAARA - accumulated dollar amount to be posted to 1358 by batch
; QQ( - (optional) array of line items
; HX - (optional) line number selected from QQ( array
; output
; FZ - may be updated
; FBAARA - may be updated
; QQ(HX) - may be deleted
; FBRFLAG - will be set =1 if 1358 needs to be posted by batch
;
N FBX
; flag line as rejected
S FBX=$$SETREJ^FBAAVR4(FBN,FBTYPE,FBIENS,"",FBRR)
;
; if problem
I 'FBX D
. W !,"Error rejecting line with IENS "_FBIENS
. W !," "_$P(FBX,"^",2)
;
; if success
I FBX D
. N FBPBYINV
. I $G(HX)'="" K QQ(HX) ; remove from list
. ; determine if 1358 posted by invoice or batch
. S FBPBYINV=0
. I FBTYPE="B9",$$GET1^DIQ(162.5,FBIENS,4,"I")'["FB583" S FBPBYINV=1
. ;
. ; if by batch then accumulate amount for later posting
. I 'FBPBYINV S FBAARA=FBAARA+$P(FBX,"^",3),FBRFLAG=1
. ;
. ; if by B9 invoice then post it now
. I FBPBYINV D
. . N FBX1
. . S FBX1=$$POSTINV^FB1358(FBN,+FBIENS,"R")
. . I 'FBX1 D
. . . W !,"Error posting invoice "_+FBIENS_" to 1358"
. . . W !," "_$P(FBX1,"^",2)
;
; update variable FZ with current batch counts and totals
S FZ=^FBAA(161.7,FBN,0)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAVR0 3094 printed Apr 09, 2024@21:06:51 Page 2
FBAAVR0 ;AISC/GRR,SAB - REJECT ITEMS ;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 ;
VCHNH ; set DATE FINALIZED for batch type B9 line items
+1 FOR J=0:0
SET J=$ORDER(^FBAAI("AC",B,J))
if J'>0
QUIT
IF '$DATA(^FBAAI(J,"FBREJ"))
IF $DATA(^FBAAI(J,0))
SET DA=J
SET DIE="^FBAAI("
SET DR="19////^S X=DT"
DO ^DIE
+2 KILL DIE,DA
+3 QUIT
+4 ;
DELC ; specify local rejects for batch type B9
+1 NEW FBIENS
+2 ; select patient
+3 SET FBDFN=$$ASKVET^FBAAUTL1("I $D(^FBAAI(""AE"",B,+Y))")
+4 if 'FBDFN
QUIT
+5 KILL QQ
+6 SET (QQ,FBAAOUT)=0
WRITE @IOF
DO HEDC^FBAACCB1
FOR I=0:0
SET I=$ORDER(^FBAAI("AE",B,FBDFN,I))
if I'>0!(FBAAOUT)
QUIT
IF $DATA(^FBAAI(I,0))
SET Z(0)=^(0)
SET FBI=I
DO WRITC
+7 ;
RL 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 DELC
if Y
GOTO LOOP
RL1 SET DIR(0)="NO^1:"_QQ
SET DIR("A")="Reject which line item"
DO ^DIR
KILL DIR
if X=""!$DATA(DIRUT)
GOTO DELC
SET HX=X
+1 IF '$DATA(QQ(HX))
WRITE !,*7,"You already rejected that one!!"
GOTO RL1
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 RL1
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 SET FBIENS=QQ(HX)_","
DO REJLN
RDMORE 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 RL1
+1 QUIT
+2 ;
WRITC SET QQ=QQ+1
SET QQ(QQ)=I
DO CMORE^FBAACCB1
+1 QUIT
+2 ;
LOOP SET DIR(0)="F^2:40"
SET DIR("A")="Reason for rejecting"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
WRITE !!,"Required Response!!"
if $DATA(DIRUT)
GOTO LOOP
SET FBRR=X
+1 FOR HX=0:0
SET HX=$ORDER(QQ(HX))
if HX'>0
QUIT
SET FBIENS=QQ(HX)_","
DO REJLN
+2 WRITE !,"...DONE!"
+3 GOTO DELC
+4 ;
REJLN ; flag line item as rejected
+1 ; input
+2 ; FBN - batch IEN
+3 ; FBTYPE - batch type
+4 ; FZ - zero node of batch (file 161.7)
+5 ; FBIENS - iens of line item
+6 ; FBRR - reject reason
+7 ; FBAARA - accumulated dollar amount to be posted to 1358 by batch
+8 ; QQ( - (optional) array of line items
+9 ; HX - (optional) line number selected from QQ( array
+10 ; output
+11 ; FZ - may be updated
+12 ; FBAARA - may be updated
+13 ; QQ(HX) - may be deleted
+14 ; FBRFLAG - will be set =1 if 1358 needs to be posted by batch
+15 ;
+16 NEW FBX
+17 ; flag line as rejected
+18 SET FBX=$$SETREJ^FBAAVR4(FBN,FBTYPE,FBIENS,"",FBRR)
+19 ;
+20 ; if problem
+21 IF 'FBX
Begin DoDot:1
+22 WRITE !,"Error rejecting line with IENS "_FBIENS
+23 WRITE !," "_$PIECE(FBX,"^",2)
End DoDot:1
+24 ;
+25 ; if success
+26 IF FBX
Begin DoDot:1
+27 NEW FBPBYINV
+28 ; remove from list
IF $GET(HX)'=""
KILL QQ(HX)
+29 ; determine if 1358 posted by invoice or batch
+30 SET FBPBYINV=0
+31 IF FBTYPE="B9"
IF $$GET1^DIQ(162.5,FBIENS,4,"I")'["FB583"
SET FBPBYINV=1
+32 ;
+33 ; if by batch then accumulate amount for later posting
+34 IF 'FBPBYINV
SET FBAARA=FBAARA+$PIECE(FBX,"^",3)
SET FBRFLAG=1
+35 ;
+36 ; if by B9 invoice then post it now
+37 IF FBPBYINV
Begin DoDot:2
+38 NEW FBX1
+39 SET FBX1=$$POSTINV^FB1358(FBN,+FBIENS,"R")
+40 IF 'FBX1
Begin DoDot:3
+41 WRITE !,"Error posting invoice "_+FBIENS_" to 1358"
+42 WRITE !," "_$PIECE(FBX1,"^",2)
End DoDot:3
End DoDot:2
End DoDot:1
+43 ;
+44 ; update variable FZ with current batch counts and totals
+45 SET FZ=^FBAA(161.7,FBN,0)
+46 ;
+47 QUIT
