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

FBAARR1.m

Go to the documentation of this file.
  1. FBAARR1 ;AISC/GRR - FEE BASIS REINITIATE ENTIRE BATCH ;3/19/2014
  1. ;;3.5;FEE BASIS;**61,132,154**;JAN 30, 1995;Build 12
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. RD S DIR(0)="Y",DIR("A")="Are you sure you want to re-initiate all line items in this batch",DIR("B")="NO"
  1. D ^DIR K DIR G:$D(DIRUT)!'Y RD1^FBAARR
  1. D WAIT^DICD
  1. S (FBRJS,FBRJV)=0
  1. D ALLM:FBTYPE="B3",ALLT:FBTYPE="B2",ALLP:FBTYPE="B5",ALLC:FBTYPE="B9"
  1. K FBRJS,FBRJV
  1. D UNLK^FBAARR
  1. G BT^FBAARR
  1. ;
  1. ALLM ; re-initiate all rejected line items in medical (B3) type batch
  1. K FBILM
  1. F J=0:0 S J=$O(^FBAAC("AH",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAAC("AH",B,J,K)) Q:K'>0 F L=0:0 S L=$O(^FBAAC("AH",B,J,K,L)) Q:L'>0 F M=0:0 S M=$O(^FBAAC("AH",B,J,K,L,M)) Q:M'>0 D REJM
  1. ; Assign new invoice number to moved lines if medical invoice was split
  1. I $$CKSPLIT^FBAARR(B,.FBILM) S DIR(0)="E" D ^DIR K DIR
  1. ADONE ;
  1. W !!,"All rejected items have been re-initiated"
  1. I '$G(FBRJS),'$G(FBRJV) W "!"
  1. I $G(FBRJS)!$G(FBRJV) D
  1. . W " with the following exceptions."
  1. . I $G(FBRJS) W !,"One or more payments were not re-initiated due to separation of duties."
  1. . I $G(FBRJV) W !,"Voided payments were not re-initiated."
  1. Q
  1. ;
  1. REJM S FBIN=+$P(^FBAAC(J,1,K,1,L,1,M,0),"^",16)
  1. I $P(^FBAAC(J,1,K,1,L,1,M,0),"^",21)="VP" D VOID S FBRJV=1 Q
  1. N FTP
  1. ;
  1. S FTP=$P($G(^FBAAC(J,1,K,1,L,1,M,3)),U,9)
  1. I FTP,'$$UOKPAY^FBUTL9(J,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
  1. . W !!,"You cannot re-initiate invoice ",$P(^FBAAC(J,1,K,1,L,1,M,0),"^",16)," due to separation of duties."
  1. . S FBERR=1
  1. ;
  1. S FBX=$$DELREJ^FBAARR3("162.03",M_","_L_","_K_","_J_",",FBNB)
  1. I 'FBX D
  1. . W !,"Error re-initiating line with IENs = "_M_","_L_","_K_","_J_","
  1. . W !," ",$P(FBX,U,2)
  1. . S FBERR=1
  1. ; update list of invoice lines that were moved to the new batch
  1. S FBILM(FBIN,M_","_L_","_K_","_J_",")=""
  1. Q
  1. ;
  1. ALLT F J=0:0 S J=$O(^FBAAC("AG",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAAC("AG",B,J,K)) Q:K'>0 D REJT
  1. G ADONE
  1. REJT ;SETUP REJECT FIELDS FOR TRAVEL
  1. N FTP
  1. ;
  1. S FTP=$P($G(^FBAAC(J,3,K,1)),U,1)
  1. I FTP,'$$UOKPAY^FBUTL9(J,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
  1. . W !!,"You cannot re-initiate travel payment due to separation of duties."
  1. . S FBERR=1
  1. ;
  1. S FBX=$$DELREJ^FBAARR3("162.04",K_","_J_",",FBNB)
  1. I 'FBX D
  1. . W !,"Error re-initiating line with IENs = "_K_","_J_","
  1. . W !," ",$P(FBX,U,2)
  1. . S FBERR=1
  1. Q
  1. ;
  1. ALLP F J=0:0 S J=$O(^FBAA(162.1,"AF",B,J)) Q:J'>0 F K=0:0 S K=$O(^FBAA(162.1,"AF",B,J,K)) Q:K'>0 D REJP
  1. G ADONE
  1. REJP I $P($G(^FBAA(162.1,J,"RX",K,2)),"^",3)="V" S FBIN=J D VOID S FBRJV=1 Q
  1. N FBDFN,FTP
  1. ;
  1. S FBDFN=$P($G(^FBAA(162.1,J,"RX",K,0)),"^",5)
  1. S FTP=$P($G(^FBAA(162.1,J,"RX",K,2)),"^",7)
  1. I FBDFN,FTP,'$$UOKPAY^FBUTL9(FBDFN,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
  1. . W !!,"You cannot re-initiate invoice ",J," due to separation of duties."
  1. . S FBERR=1
  1. ;
  1. S FBX=$$DELREJ^FBAARR3("162.11",K_","_J_",",FBNB)
  1. I 'FBX D
  1. . W !,"Error re-initiating line with IENs = "_K_","_J_","
  1. . W !," ",$P(FBX,U,2)
  1. . S FBERR=1
  1. Q
  1. ;
  1. ALLC F J=0:0 S J=$O(^FBAAI("AH",B,J)) Q:J'>0 I $D(^FBAAI(J,0)) D REJC
  1. G ADONE
  1. REJC I $P(^FBAAI(J,0),"^",14)="VP" S FBIN=J D VOID S FBRJV=1 Q
  1. N FBDFN,FBI7078,FTP
  1. ;
  1. S FBDFN=$P(^FBAAI(J,0),"^",4)
  1. S FBI7078=$P(^FBAAI(J,0),"^",5)
  1. S FTP=$S(FBI7078]"":$O(^FBAAA("AG",FBI7078,FBDFN,0)),1:"")
  1. I FBDFN,FTP,'$$UOKPAY^FBUTL9(FBDFN,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
  1. . W !!,"You cannot re-initiate invoice ",J," due to separation of duties."
  1. . S FBERR=1
  1. ;
  1. S FBX=$$DELREJ^FBAARR3(162.5,J_",",FBNB)
  1. I 'FBX D
  1. . W !,"Error re-initiating line with IENs = "_J_","
  1. . W !," ",$P(FBX,U,2)
  1. . S FBERR=1
  1. Q
  1. ;
  1. KILL K A,A1,A2,B,CPTDESC,D0,DA,FBAACPT,FBAAOUT,FBVP,J,K,L,M,X,Y,Z,DIC,ERR,FBIN,FBNB,FBNUM,FBPV,FBRR,FBTYPE,FBVD,FBVDUZ,FZ,I,POP,DR,IOP,V,VID,ZS,FBN,FBOB,FBNOB,CNT,Q,UL,VAL,FBINTOT,PRCS,PRCSI,FBFDC,FBMST,FBTTYPE,FBSTN,FBDCB,FBBN
  1. K FBAAAP,FBAC,FBAP,FBDX,FBFD,FBK,FBL,FBPDT,FBPROC,FBSC,FBINOLD,FBTD,N,S,FBCNT,FBNBCNT,I,DIRUT,FBEXMPT,FBX
  1. K FBAAMPI,HX,B2,FBERR
  1. Q
  1. ;
  1. BATCNT ;GET NUMBER OF REJECTS IN OLD BATCH
  1. S:'$D(FBAAMPI) FBAAMPI=$S($D(^FBAA(161.4,1,"FBNUM")):$P(^("FBNUM"),"^",3),1:100),FBAAMPI=$S(FBAAMPI]"":FBAAMPI,1:100)
  1. Q:'$D(FBN) S FBCNT=0
  1. F I=0:0 S I=$O(^FBAAC("AH",FBN,I)) Q:'I F J=0:0 S J=$O(^FBAAC("AH",FBN,I,J)) Q:'J F K=0:0 S K=$O(^FBAAC("AH",FBN,I,J,K)) Q:'K F L=0:0 S L=$O(^FBAAC("AH",FBN,I,J,K,L)) Q:'L I $D(^FBAAC(I,1,J,1,K,1,L,"FBREJ")) S FBCNT=FBCNT+1
  1. Q:'$D(FBNB)
  1. S FBNBCNT=$S($D(^FBAA(161.7,FBNB,0)):(FBAAMPI-$P(^(0),"^",11)),1:0)
  1. I FBCNT>FBNBCNT W !!,*7,"New Batch selected does not have enough room to fit the",!,FBCNT," rejects pending from batch ",$P(FZ,"^")," !",!! K FBNB Q
  1. Q
  1. ;
  1. VOID W !!,*7,"Invoice #: ",FBIN," has a status of VOID. Please delete the VOID",!,"before re-initiating this rejected payment."
  1. Q