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

FBAARD0.m

Go to the documentation of this file.
  1. FBAARD0 ;AISC/GRR - DELETE REJECTS ENTERED IN ERROR (CONT.) ;3/28/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. HELPD ;
  1. W !!,"If you answer 'Yes' to this question, the reject flag will be deleted from all"
  1. W !,"locally rejected line items in this batch. If you answer 'No', you will be"
  1. W !,"asked if you want to delete the reject flag from specific line items."
  1. Q
  1. DELC ; specify line items rejected in error for batch type B9
  1. S (QQ,FBAAOUT)=0 W @IOF D HEDC^FBAACCB1 F I=0:0 S I=$O(^FBAAI("AH",B,I)) Q:I'>0!(FBAAOUT) I $D(^FBAAI(I,0)) S Z(0)=^(0) D WRITC
  1. I QQ=0 W !,"No local rejects found in batch!" Q
  1. RL S DIR(0)="N^1:"_QQ,DIR("A")="Delete reject flag for which line item" D ^DIR K DIR Q:$D(DIRUT) S HX=X
  1. I '$D(QQ(HX)) W !,*7,"You already did that one !!" G RL
  1. ASKSU S DIR(0)="Y",DIR("A")="Are you sure you want to delete the reject on item number "_HX,DIR("B")="NO" D ^DIR K DIR G:$D(DIRUT)!'Y RL
  1. S I=QQ(HX),(FBAAAP,FBAAMT)=+$P(^FBAAI(I,0),"^",9),FBII78=$P($G(^(0)),"^",5),FBMM=$E($P(^(0),U,6),4,5) S FBINVI=I D INPOST^FBAARD3 S I=FBINVI K FBINVI I $D(FBERR) G PROB^FBAARD1
  1. S FBX=$$DELREJ^FBAARR3(162.5,I_",")
  1. I 'FBX D
  1. . W !,"1358 was updated, but error occured while deleting the reject"
  1. . W !,"flag for line with IENS = "_I_","
  1. . W !," ",$P(FBX,"^",2)
  1. . S FBERR=1
  1. K QQ(HX),FBMM
  1. W !,"...Done"
  1. I '$D(^FBAAI("AH",B)) Q
  1. RDMORE S DIR(0)="Y",DIR("A")=$S($G(FBERR):"",1:"Item Deleted. ")_"Want to delete another",DIR("B")="YES" D ^DIR K DIR G RDMORE:$D(DIRUT),RL:Y
  1. Q
  1. WRITC ;
  1. Q:$P($G(^FBAAI(I,"FBREJ")),"^",4)=1 ; skip interface rejects
  1. S QQ=QQ+1,QQ(QQ)=I D CMORE^FBAACCB1 Q