- FBAARR1 ;AISC/GRR - FEE BASIS REINITIATE ENTIRE BATCH ;3/19/2014
- ;;3.5;FEE BASIS;**61,132,154**;JAN 30, 1995;Build 12
- ;;Per VA Directive 6402, this routine should not be modified.
- RD S DIR(0)="Y",DIR("A")="Are you sure you want to re-initiate all line items in this batch",DIR("B")="NO"
- D ^DIR K DIR G:$D(DIRUT)!'Y RD1^FBAARR
- D WAIT^DICD
- S (FBRJS,FBRJV)=0
- D ALLM:FBTYPE="B3",ALLT:FBTYPE="B2",ALLP:FBTYPE="B5",ALLC:FBTYPE="B9"
- K FBRJS,FBRJV
- D UNLK^FBAARR
- G BT^FBAARR
- ;
- ALLM ; re-initiate all rejected line items in medical (B3) type batch
- K FBILM
- 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
- ; Assign new invoice number to moved lines if medical invoice was split
- I $$CKSPLIT^FBAARR(B,.FBILM) S DIR(0)="E" D ^DIR K DIR
- ADONE ;
- W !!,"All rejected items have been re-initiated"
- I '$G(FBRJS),'$G(FBRJV) W "!"
- I $G(FBRJS)!$G(FBRJV) D
- . W " with the following exceptions."
- . I $G(FBRJS) W !,"One or more payments were not re-initiated due to separation of duties."
- . I $G(FBRJV) W !,"Voided payments were not re-initiated."
- Q
- ;
- REJM S FBIN=+$P(^FBAAC(J,1,K,1,L,1,M,0),"^",16)
- I $P(^FBAAC(J,1,K,1,L,1,M,0),"^",21)="VP" D VOID S FBRJV=1 Q
- N FTP
- ;
- S FTP=$P($G(^FBAAC(J,1,K,1,L,1,M,3)),U,9)
- I FTP,'$$UOKPAY^FBUTL9(J,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
- . W !!,"You cannot re-initiate invoice ",$P(^FBAAC(J,1,K,1,L,1,M,0),"^",16)," due to separation of duties."
- . S FBERR=1
- ;
- S FBX=$$DELREJ^FBAARR3("162.03",M_","_L_","_K_","_J_",",FBNB)
- I 'FBX D
- . W !,"Error re-initiating line with IENs = "_M_","_L_","_K_","_J_","
- . W !," ",$P(FBX,U,2)
- . S FBERR=1
- ; update list of invoice lines that were moved to the new batch
- S FBILM(FBIN,M_","_L_","_K_","_J_",")=""
- Q
- ;
- 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
- G ADONE
- REJT ;SETUP REJECT FIELDS FOR TRAVEL
- N FTP
- ;
- S FTP=$P($G(^FBAAC(J,3,K,1)),U,1)
- I FTP,'$$UOKPAY^FBUTL9(J,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
- . W !!,"You cannot re-initiate travel payment due to separation of duties."
- . S FBERR=1
- ;
- S FBX=$$DELREJ^FBAARR3("162.04",K_","_J_",",FBNB)
- I 'FBX D
- . W !,"Error re-initiating line with IENs = "_K_","_J_","
- . W !," ",$P(FBX,U,2)
- . S FBERR=1
- Q
- ;
- 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
- G ADONE
- REJP I $P($G(^FBAA(162.1,J,"RX",K,2)),"^",3)="V" S FBIN=J D VOID S FBRJV=1 Q
- N FBDFN,FTP
- ;
- S FBDFN=$P($G(^FBAA(162.1,J,"RX",K,0)),"^",5)
- S FTP=$P($G(^FBAA(162.1,J,"RX",K,2)),"^",7)
- I FBDFN,FTP,'$$UOKPAY^FBUTL9(FBDFN,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
- . W !!,"You cannot re-initiate invoice ",J," due to separation of duties."
- . S FBERR=1
- ;
- S FBX=$$DELREJ^FBAARR3("162.11",K_","_J_",",FBNB)
- I 'FBX D
- . W !,"Error re-initiating line with IENs = "_K_","_J_","
- . W !," ",$P(FBX,U,2)
- . S FBERR=1
- Q
- ;
- ALLC F J=0:0 S J=$O(^FBAAI("AH",B,J)) Q:J'>0 I $D(^FBAAI(J,0)) D REJC
- G ADONE
- REJC I $P(^FBAAI(J,0),"^",14)="VP" S FBIN=J D VOID S FBRJV=1 Q
- N FBDFN,FBI7078,FTP
- ;
- S FBDFN=$P(^FBAAI(J,0),"^",4)
- S FBI7078=$P(^FBAAI(J,0),"^",5)
- S FTP=$S(FBI7078]"":$O(^FBAAA("AG",FBI7078,FBDFN,0)),1:"")
- I FBDFN,FTP,'$$UOKPAY^FBUTL9(FBDFN,FTP) D S:$G(FBRJS)=0 FBRJS=1 Q
- . W !!,"You cannot re-initiate invoice ",J," due to separation of duties."
- . S FBERR=1
- ;
- S FBX=$$DELREJ^FBAARR3(162.5,J_",",FBNB)
- I 'FBX D
- . W !,"Error re-initiating line with IENs = "_J_","
- . W !," ",$P(FBX,U,2)
- . S FBERR=1
- Q
- ;
- 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
- K FBAAAP,FBAC,FBAP,FBDX,FBFD,FBK,FBL,FBPDT,FBPROC,FBSC,FBINOLD,FBTD,N,S,FBCNT,FBNBCNT,I,DIRUT,FBEXMPT,FBX
- K FBAAMPI,HX,B2,FBERR
- Q
- ;
- BATCNT ;GET NUMBER OF REJECTS IN OLD BATCH
- S:'$D(FBAAMPI) FBAAMPI=$S($D(^FBAA(161.4,1,"FBNUM")):$P(^("FBNUM"),"^",3),1:100),FBAAMPI=$S(FBAAMPI]"":FBAAMPI,1:100)
- Q:'$D(FBN) S FBCNT=0
- 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
- Q:'$D(FBNB)
- S FBNBCNT=$S($D(^FBAA(161.7,FBNB,0)):(FBAAMPI-$P(^(0),"^",11)),1:0)
- 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
- Q
- ;
- VOID W !!,*7,"Invoice #: ",FBIN," has a status of VOID. Please delete the VOID",!,"before re-initiating this rejected payment."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAARR1 4807 printed Feb 18, 2025@23:22:56 Page 2
- FBAARR1 ;AISC/GRR - FEE BASIS REINITIATE ENTIRE BATCH ;3/19/2014
- +1 ;;3.5;FEE BASIS;**61,132,154**;JAN 30, 1995;Build 12
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- RD SET DIR(0)="Y"
- SET DIR("A")="Are you sure you want to re-initiate all line items in this batch"
- SET DIR("B")="NO"
- +1 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!'Y
- GOTO RD1^FBAARR
- +2 DO WAIT^DICD
- +3 SET (FBRJS,FBRJV)=0
- +4 if FBTYPE="B3"
- DO ALLM
- if FBTYPE="B2"
- DO ALLT
- if FBTYPE="B5"
- DO ALLP
- if FBTYPE="B9"
- DO ALLC
- +5 KILL FBRJS,FBRJV
- +6 DO UNLK^FBAARR
- +7 GOTO BT^FBAARR
- +8 ;
- ALLM ; re-initiate all rejected line items in medical (B3) type batch
- +1 KILL FBILM
- +2 FOR J=0:0
- SET J=$ORDER(^FBAAC("AH",B,J))
- if J'>0
- QUIT
- FOR K=0:0
- SET K=$ORDER(^FBAAC("AH",B,J,K))
- if K'>0
- QUIT
- FOR L=0:0
- SET L=$ORDER(^FBAAC("AH",B,J,K,L))
- if L'>0
- QUIT
- FOR M=0:0
- SET M=$ORDER(^FBAAC("AH",B,J,K,L,M))
- if M'>0
- QUIT
- DO REJM
- +3 ; Assign new invoice number to moved lines if medical invoice was split
- +4 IF $$CKSPLIT^FBAARR(B,.FBILM)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- ADONE ;
- +1 WRITE !!,"All rejected items have been re-initiated"
- +2 IF '$GET(FBRJS)
- IF '$GET(FBRJV)
- WRITE "!"
- +3 IF $GET(FBRJS)!$GET(FBRJV)
- Begin DoDot:1
- +4 WRITE " with the following exceptions."
- +5 IF $GET(FBRJS)
- WRITE !,"One or more payments were not re-initiated due to separation of duties."
- +6 IF $GET(FBRJV)
- WRITE !,"Voided payments were not re-initiated."
- End DoDot:1
- +7 QUIT
- +8 ;
- REJM SET FBIN=+$PIECE(^FBAAC(J,1,K,1,L,1,M,0),"^",16)
- +1 IF $PIECE(^FBAAC(J,1,K,1,L,1,M,0),"^",21)="VP"
- DO VOID
- SET FBRJV=1
- QUIT
- +2 NEW FTP
- +3 ;
- +4 SET FTP=$PIECE($GET(^FBAAC(J,1,K,1,L,1,M,3)),U,9)
- +5 IF FTP
- IF '$$UOKPAY^FBUTL9(J,FTP)
- Begin DoDot:1
- +6 WRITE !!,"You cannot re-initiate invoice ",$PIECE(^FBAAC(J,1,K,1,L,1,M,0),"^",16)," due to separation of duties."
- +7 SET FBERR=1
- End DoDot:1
- if $GET(FBRJS)=0
- SET FBRJS=1
- QUIT
- +8 ;
- +9 SET FBX=$$DELREJ^FBAARR3("162.03",M_","_L_","_K_","_J_",",FBNB)
- +10 IF 'FBX
- Begin DoDot:1
- +11 WRITE !,"Error re-initiating line with IENs = "_M_","_L_","_K_","_J_","
- +12 WRITE !," ",$PIECE(FBX,U,2)
- +13 SET FBERR=1
- End DoDot:1
- +14 ; update list of invoice lines that were moved to the new batch
- +15 SET FBILM(FBIN,M_","_L_","_K_","_J_",")=""
- +16 QUIT
- +17 ;
- ALLT FOR J=0:0
- SET J=$ORDER(^FBAAC("AG",B,J))
- if J'>0
- QUIT
- FOR K=0:0
- SET K=$ORDER(^FBAAC("AG",B,J,K))
- if K'>0
- QUIT
- DO REJT
- +1 GOTO ADONE
- REJT ;SETUP REJECT FIELDS FOR TRAVEL
- +1 NEW FTP
- +2 ;
- +3 SET FTP=$PIECE($GET(^FBAAC(J,3,K,1)),U,1)
- +4 IF FTP
- IF '$$UOKPAY^FBUTL9(J,FTP)
- Begin DoDot:1
- +5 WRITE !!,"You cannot re-initiate travel payment due to separation of duties."
- +6 SET FBERR=1
- End DoDot:1
- if $GET(FBRJS)=0
- SET FBRJS=1
- QUIT
- +7 ;
- +8 SET FBX=$$DELREJ^FBAARR3("162.04",K_","_J_",",FBNB)
- +9 IF 'FBX
- Begin DoDot:1
- +10 WRITE !,"Error re-initiating line with IENs = "_K_","_J_","
- +11 WRITE !," ",$PIECE(FBX,U,2)
- +12 SET FBERR=1
- End DoDot:1
- +13 QUIT
- +14 ;
- ALLP FOR J=0:0
- SET J=$ORDER(^FBAA(162.1,"AF",B,J))
- if J'>0
- QUIT
- FOR K=0:0
- SET K=$ORDER(^FBAA(162.1,"AF",B,J,K))
- if K'>0
- QUIT
- DO REJP
- +1 GOTO ADONE
- REJP IF $PIECE($GET(^FBAA(162.1,J,"RX",K,2)),"^",3)="V"
- SET FBIN=J
- DO VOID
- SET FBRJV=1
- QUIT
- +1 NEW FBDFN,FTP
- +2 ;
- +3 SET FBDFN=$PIECE($GET(^FBAA(162.1,J,"RX",K,0)),"^",5)
- +4 SET FTP=$PIECE($GET(^FBAA(162.1,J,"RX",K,2)),"^",7)
- +5 IF FBDFN
- IF FTP
- IF '$$UOKPAY^FBUTL9(FBDFN,FTP)
- Begin DoDot:1
- +6 WRITE !!,"You cannot re-initiate invoice ",J," due to separation of duties."
- +7 SET FBERR=1
- End DoDot:1
- if $GET(FBRJS)=0
- SET FBRJS=1
- QUIT
- +8 ;
- +9 SET FBX=$$DELREJ^FBAARR3("162.11",K_","_J_",",FBNB)
- +10 IF 'FBX
- Begin DoDot:1
- +11 WRITE !,"Error re-initiating line with IENs = "_K_","_J_","
- +12 WRITE !," ",$PIECE(FBX,U,2)
- +13 SET FBERR=1
- End DoDot:1
- +14 QUIT
- +15 ;
- ALLC FOR J=0:0
- SET J=$ORDER(^FBAAI("AH",B,J))
- if J'>0
- QUIT
- IF $DATA(^FBAAI(J,0))
- DO REJC
- +1 GOTO ADONE
- REJC IF $PIECE(^FBAAI(J,0),"^",14)="VP"
- SET FBIN=J
- DO VOID
- SET FBRJV=1
- QUIT
- +1 NEW FBDFN,FBI7078,FTP
- +2 ;
- +3 SET FBDFN=$PIECE(^FBAAI(J,0),"^",4)
- +4 SET FBI7078=$PIECE(^FBAAI(J,0),"^",5)
- +5 SET FTP=$SELECT(FBI7078]"":$ORDER(^FBAAA("AG",FBI7078,FBDFN,0)),1:"")
- +6 IF FBDFN
- IF FTP
- IF '$$UOKPAY^FBUTL9(FBDFN,FTP)
- Begin DoDot:1
- +7 WRITE !!,"You cannot re-initiate invoice ",J," due to separation of duties."
- +8 SET FBERR=1
- End DoDot:1
- if $GET(FBRJS)=0
- SET FBRJS=1
- QUIT
- +9 ;
- +10 SET FBX=$$DELREJ^FBAARR3(162.5,J_",",FBNB)
- +11 IF 'FBX
- Begin DoDot:1
- +12 WRITE !,"Error re-initiating line with IENs = "_J_","
- +13 WRITE !," ",$PIECE(FBX,U,2)
- +14 SET FBERR=1
- End DoDot:1
- +15 QUIT
- +16 ;
- KILL KILL 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 KILL FBAAAP,FBAC,FBAP,FBDX,FBFD,FBK,FBL,FBPDT,FBPROC,FBSC,FBINOLD,FBTD,N,S,FBCNT,FBNBCNT,I,DIRUT,FBEXMPT,FBX
- +2 KILL FBAAMPI,HX,B2,FBERR
- +3 QUIT
- +4 ;
- BATCNT ;GET NUMBER OF REJECTS IN OLD BATCH
- +1 if '$DATA(FBAAMPI)
- SET FBAAMPI=$SELECT($DATA(^FBAA(161.4,1,"FBNUM")):$PIECE(^("FBNUM"),"^",3),1:100)
- SET FBAAMPI=$SELECT(FBAAMPI]"":FBAAMPI,1:100)
- +2 if '$DATA(FBN)
- QUIT
- SET FBCNT=0
- +3 FOR I=0:0
- SET I=$ORDER(^FBAAC("AH",FBN,I))
- if 'I
- QUIT
- FOR J=0:0
- SET J=$ORDER(^FBAAC("AH",FBN,I,J))
- if 'J
- QUIT
- FOR K=0:0
- SET K=$ORDER(^FBAAC("AH",FBN,I,J,K))
- if 'K
- QUIT
- FOR L=0:0
- SET L=$ORDER(^FBAAC("AH",FBN,I,J,K,L))
- if 'L
- QUIT
- IF $DATA(^FBAAC(I,1,J,1,K,1,L,"FBREJ"))
- SET FBCNT=FBCNT+1
- +4 if '$DATA(FBNB)
- QUIT
- +5 SET FBNBCNT=$SELECT($DATA(^FBAA(161.7,FBNB,0)):(FBAAMPI-$PIECE(^(0),"^",11)),1:0)
- +6 IF FBCNT>FBNBCNT
- WRITE !!,*7,"New Batch selected does not have enough room to fit the",!,FBCNT," rejects pending from batch ",$PIECE(FZ,"^")," !",!!
- KILL FBNB
- QUIT
- +7 QUIT
- +8 ;
- VOID WRITE !!,*7,"Invoice #: ",FBIN," has a status of VOID. Please delete the VOID",!,"before re-initiating this rejected payment."
- +1 QUIT