Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBAAVR0

FBAAVR0.m

Go to the documentation of this file. 
  1. FBAAVR0 ;AISC/GRR,SAB - REJECT ITEMS ;3/26/2012
  1.  ;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;
  1. VCHNH ; set DATE FINALIZED for batch type B9 line items
  1.  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
  1.  K DIE,DA
  1.  Q
  1.  ;
  1. DELC ; specify local rejects for batch type B9
  1.  N FBIENS
  1.  ; select patient
  1.  S FBDFN=$$ASKVET^FBAAUTL1("I $D(^FBAAI(""AE"",B,+Y))")
  1.  Q:'FBDFN
  1.  K QQ
  1.  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
  1.  ;
  1. 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
  1. 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
  1.  I '$D(QQ(HX)) W !,*7,"You already rejected that one!!" G RL1
  1. 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
  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
  1.  S FBIENS=QQ(HX)_"," D REJLN
  1. 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
  1.  Q
  1.  ;
  1. WRITC S QQ=QQ+1,QQ(QQ)=I D CMORE^FBAACCB1
  1.  Q
  1.  ;
  1. 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
  1.  F HX=0:0 S HX=$O(QQ(HX)) Q:HX'>0  S FBIENS=QQ(HX)_"," D REJLN
  1.  W !,"...DONE!"
  1.  G DELC
  1.  ;
  1. REJLN ; flag line item as rejected
  1.  ; input
  1.  ;   FBN    - batch IEN
  1.  ;   FBTYPE - batch type
  1.  ;   FZ     - zero node of batch (file 161.7)
  1.  ;   FBIENS - iens of line item
  1.  ;   FBRR   - reject reason
  1.  ;   FBAARA - accumulated dollar amount to be posted to 1358 by batch
  1.  ;   QQ(    - (optional) array of line items
  1.  ;   HX     - (optional) line number selected from QQ( array
  1.  ; output
  1.  ;   FZ      - may be updated
  1.  ;   FBAARA  - may be updated
  1.  ;   QQ(HX)  - may be deleted
  1.  ;   FBRFLAG - will be set =1 if 1358 needs to be posted by batch
  1.  ;
  1.  N FBX
  1.  ; flag line as rejected
  1.  S FBX=$$SETREJ^FBAAVR4(FBN,FBTYPE,FBIENS,"",FBRR)
  1.  ;
  1.  ; if problem
  1.  I 'FBX D
  1.  . W !,"Error rejecting line with IENS "_FBIENS
  1.  . W !,"  "_$P(FBX,"^",2)
  1.  ;
  1.  ; if success
  1.  I FBX D
  1.  . N FBPBYINV
  1.  . I $G(HX)'="" K QQ(HX) ; remove from list
  1.  . ; determine if 1358 posted by invoice or batch
  1.  . S FBPBYINV=0
  1.  . I FBTYPE="B9",$$GET1^DIQ(162.5,FBIENS,4,"I")'["FB583" S FBPBYINV=1
  1.  . ;
  1.  . ; if by batch then accumulate amount for later posting
  1.  . I 'FBPBYINV S FBAARA=FBAARA+$P(FBX,"^",3),FBRFLAG=1
  1.  . ;
  1.  . ; if by B9 invoice then post it now
  1.  . I FBPBYINV D
  1.  . . N FBX1
  1.  . . S FBX1=$$POSTINV^FB1358(FBN,+FBIENS,"R")
  1.  . . I 'FBX1 D
  1.  . . . W !,"Error posting invoice "_+FBIENS_" to 1358"
  1.  . . . W !,"  "_$P(FBX1,"^",2)
  1.  ;
  1.  ; update variable FZ with current batch counts and totals
  1.  S FZ=^FBAA(161.7,FBN,0)
  1.  ;
  1.  Q