FBAARR3 ;WOIFO/SAB - REINITIATE REJECTED LINE ITEMS ;4/26/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
; ICRs
; #2053 FILE^DIE
; #2054 CLEAN^DILF, DA^DILF
; #2056 $$GET1^DIQ, GETS^DIQ
;
DELREJ(FBFILE,FBPIENS,FBNB) ; Delete Reject Flag
; input
; FBFILE - payment file (162.03, 162.04, 162.11, 162.5)
; FBPIENS - IEN of payment line in file, FileMan DBS format
; FBNB - IEN of new batch, only pass when re-initiate
; return value
; =1 when successfully processed
; =0^message when not
;
N FBAP,FBFIELDS,FBN,FBRET,FBSKIPIC
S FBRET=1
;
; verify inputs
I $G(FBFILE)="" S FBRET="0^File number not provided."
I $G(FBPIENS)="" S FBRET="0^Line Item IENs not provided."
I $G(FBNB),"^O^A^"'[("^"_$$GET1^DIQ(161.7,FBNB_",",11,"I")_"^") D
. S FBRET="0^New batch status is not OPEN or ASSIGNED PRICE."
;
; determine field numbers based on file
I FBRET D
. ; FBFIELDS will contain the numbers of the following fields/sub-file
. ; piece 1 = batch number
. ; piece 2 = amount paid
. ; piece 3 = reject status
. ; piece 4 = reject reason
. ; piece 5 = old batch number
. ; piece 6 = interface reject
. ; piece 7 = reject code
. ; piece 8 = reject code sub-file number
. I FBFILE="162.03" S FBFIELDS="7^2^19^20^21^21.3^21.6^162.031"
. I FBFILE="162.04" S FBFIELDS="1^2^4^5^6^6.3^6.6^162.041"
. I FBFILE="162.11" S FBFIELDS="13^6.5^17^18^19^19.3^19.6^162.111"
. I FBFILE="162.5" S FBFIELDS="20^8^13^14^15^15.3^15.6^162.515"
. I $G(FBFIELDS)="" S FBRET="0^Could not determine field numbers"
;
; get line item data
I FBRET D
. S FBAP=$$GET1^DIQ(FBFILE,FBPIENS,$P(FBFIELDS,"^",2)) ; amount paid
. S FBN=$$GET1^DIQ(FBFILE,FBPIENS,$P(FBFIELDS,"^",5),"I") ; old batch
. I FBN="" S FBRET="0^OLD BATCH NUMBER is null, Line is not rejected."
;
; restore to original batch when input FBNB is null (not re-initiate)
I FBRET D
. S:$G(FBNB)="" FBNB=FBN
;
; if file is 162.11 and invoice already has a line on the batch then
; set flag to prevent increase to the batch invoice count
I FBRET,FBFILE=162.11 D
. I $O(^FBAA(162.1,"AE",FBNB,$P(FBPIENS,",",2),0)) S FBSKIPIC=1
;
; update line item
I FBRET D
. N DIERR,FBFDA,FBRIENS,FBX
. S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",1))=FBNB ; batch number
. S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",3))="@" ; reject status
. S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",4))="@" ; reject reason
. S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",5))="@" ; old batch number
. S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",6))="@" ; interface reject
. ;
. ; get list of entries in REJECT CODE multiple
. D GETS^DIQ(FBFILE,FBPIENS,$P(FBFIELDS,"^",7)_"*","","FBX")
. ;
. ; loop thru REJECT CODE entries
. S FBRIENS=""
. F S FBRIENS=$O(FBX($P(FBFIELDS,"^",8),FBRIENS)) Q:FBRIENS="" D
. . S FBFDA($P(FBFIELDS,"^",8),FBRIENS,.01)="@" ; REJECT CODE
. ;
. D FILE^DIE("","FBFDA")
. I $D(DIERR) S FBRET="0^Error updating line item."
. D CLEAN^DILF
;
I FBRET D
. ; the software often checks $DATA of the "FBREJ" node to determine
. ; if a line item is flagged as rejected. To ensure this checks works
. ; correctly the node will be killed.
. N FBDA
. D DA^DILF(FBPIENS,.FBDA)
. I FBFILE=162.03 K ^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,"FBREJ")
. I FBFILE=162.04 K ^FBAAC(FBDA(1),3,FBDA,"FBREJ")
. I FBFILE=162.11 K ^FBAA(162.1,FBDA(1),"RX",FBDA,"FBREJ")
. I FBFILE=162.5 K ^FBAAI(FBDA,"FBREJ")
;
; update new batch fields to reflect addition of line item
I FBRET D
. N DIERR,FBFDA,FBIC,FBLC,FBTOT
. ; get existing data
. S FBTOT=$$GET1^DIQ(161.7,FBNB_",",8) ; TOTAL DOLLARS
. S FBIC=$$GET1^DIQ(161.7,FBNB_",",9) ; INVOICE COUNT
. S FBLC=$$GET1^DIQ(161.7,FBNB_",",10) ; PAYMENT LINE COUNT
. ;
. S FBFDA(161.7,FBNB_",",8)=FBTOT+FBAP ; TOTAL DOLLARS
. S FBFDA(161.7,FBNB_",",10)=FBLC+1 ; PAYMENT LINE COUNT
. ; update INVOICE COUNT when appropriate
. ; this field is not curently maintained for batch types B2 and B3
. I FBFILE=162.5 S FBFDA(161.7,FBNB_",",9)=FBIC+1 ; INVOICE COUNT
. I FBFILE=162.11,'$G(FBSKIPIC) D
. . S FBFDA(161.7,FBNB_",",9)=FBIC+1 ; INVOICE COUNT
. ;
. I $D(FBFDA) D FILE^DIE("","FBFDA")
. I $D(DIERR) S FBRET="0^Error updating data for new batch."
. D CLEAN^DILF
;
; update old batch if no more rejects pending
I FBRET D
. N DIERR,FBFDA
. I FBFILE=162.03,$D(^FBAAC("AH",FBN)) Q
. I FBFILE=162.04,$D(^FBAAC("AG",FBN)) Q
. I FBFILE=162.11,$D(^FBAA(162.1,"AF",FBN)) Q
. I FBFILE=162.5,$D(^FBAAI("AH",FBN)) Q
. S FBFDA(161.7,FBN_",",15)="@" ; REJECTS PENDING
. I $D(FBFDA) D FILE^DIE("","FBFDA")
. I $D(DIERR) S FBRET="0^Error updating data for old batch."
. D CLEAN^DILF
;
Q FBRET
;
;FBAARR3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAARR3 4850 printed Oct 16, 2024@17:57:22 Page 2
FBAARR3 ;WOIFO/SAB - REINITIATE REJECTED LINE ITEMS ;4/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 ;
+5 ; ICRs
+6 ; #2053 FILE^DIE
+7 ; #2054 CLEAN^DILF, DA^DILF
+8 ; #2056 $$GET1^DIQ, GETS^DIQ
+9 ;
DELREJ(FBFILE,FBPIENS,FBNB) ; Delete Reject Flag
+1 ; input
+2 ; FBFILE - payment file (162.03, 162.04, 162.11, 162.5)
+3 ; FBPIENS - IEN of payment line in file, FileMan DBS format
+4 ; FBNB - IEN of new batch, only pass when re-initiate
+5 ; return value
+6 ; =1 when successfully processed
+7 ; =0^message when not
+8 ;
+9 NEW FBAP,FBFIELDS,FBN,FBRET,FBSKIPIC
+10 SET FBRET=1
+11 ;
+12 ; verify inputs
+13 IF $GET(FBFILE)=""
SET FBRET="0^File number not provided."
+14 IF $GET(FBPIENS)=""
SET FBRET="0^Line Item IENs not provided."
+15 IF $GET(FBNB)
IF "^O^A^"'[("^"_$$GET1^DIQ(161.7,FBNB_",",11,"I")_"^")
Begin DoDot:1
+16 SET FBRET="0^New batch status is not OPEN or ASSIGNED PRICE."
End DoDot:1
+17 ;
+18 ; determine field numbers based on file
+19 IF FBRET
Begin DoDot:1
+20 ; FBFIELDS will contain the numbers of the following fields/sub-file
+21 ; piece 1 = batch number
+22 ; piece 2 = amount paid
+23 ; piece 3 = reject status
+24 ; piece 4 = reject reason
+25 ; piece 5 = old batch number
+26 ; piece 6 = interface reject
+27 ; piece 7 = reject code
+28 ; piece 8 = reject code sub-file number
+29 IF FBFILE="162.03"
SET FBFIELDS="7^2^19^20^21^21.3^21.6^162.031"
+30 IF FBFILE="162.04"
SET FBFIELDS="1^2^4^5^6^6.3^6.6^162.041"
+31 IF FBFILE="162.11"
SET FBFIELDS="13^6.5^17^18^19^19.3^19.6^162.111"
+32 IF FBFILE="162.5"
SET FBFIELDS="20^8^13^14^15^15.3^15.6^162.515"
+33 IF $GET(FBFIELDS)=""
SET FBRET="0^Could not determine field numbers"
End DoDot:1
+34 ;
+35 ; get line item data
+36 IF FBRET
Begin DoDot:1
+37 ; amount paid
SET FBAP=$$GET1^DIQ(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",2))
+38 ; old batch
SET FBN=$$GET1^DIQ(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",5),"I")
+39 IF FBN=""
SET FBRET="0^OLD BATCH NUMBER is null, Line is not rejected."
End DoDot:1
+40 ;
+41 ; restore to original batch when input FBNB is null (not re-initiate)
+42 IF FBRET
Begin DoDot:1
+43 if $GET(FBNB)=""
SET FBNB=FBN
End DoDot:1
+44 ;
+45 ; if file is 162.11 and invoice already has a line on the batch then
+46 ; set flag to prevent increase to the batch invoice count
+47 IF FBRET
IF FBFILE=162.11
Begin DoDot:1
+48 IF $ORDER(^FBAA(162.1,"AE",FBNB,$PIECE(FBPIENS,",",2),0))
SET FBSKIPIC=1
End DoDot:1
+49 ;
+50 ; update line item
+51 IF FBRET
Begin DoDot:1
+52 NEW DIERR,FBFDA,FBRIENS,FBX
+53 ; batch number
SET FBFDA(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",1))=FBNB
+54 ; reject status
SET FBFDA(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",3))="@"
+55 ; reject reason
SET FBFDA(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",4))="@"
+56 ; old batch number
SET FBFDA(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",5))="@"
+57 ; interface reject
SET FBFDA(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",6))="@"
+58 ;
+59 ; get list of entries in REJECT CODE multiple
+60 DO GETS^DIQ(FBFILE,FBPIENS,$PIECE(FBFIELDS,"^",7)_"*","","FBX")
+61 ;
+62 ; loop thru REJECT CODE entries
+63 SET FBRIENS=""
+64 FOR
SET FBRIENS=$ORDER(FBX($PIECE(FBFIELDS,"^",8),FBRIENS))
if FBRIENS=""
QUIT
Begin DoDot:2
+65 ; REJECT CODE
SET FBFDA($PIECE(FBFIELDS,"^",8),FBRIENS,.01)="@"
End DoDot:2
+66 ;
+67 DO FILE^DIE("","FBFDA")
+68 IF $DATA(DIERR)
SET FBRET="0^Error updating line item."
+69 DO CLEAN^DILF
End DoDot:1
+70 ;
+71 IF FBRET
Begin DoDot:1
+72 ; the software often checks $DATA of the "FBREJ" node to determine
+73 ; if a line item is flagged as rejected. To ensure this checks works
+74 ; correctly the node will be killed.
+75 NEW FBDA
+76 DO DA^DILF(FBPIENS,.FBDA)
+77 IF FBFILE=162.03
KILL ^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,"FBREJ")
+78 IF FBFILE=162.04
KILL ^FBAAC(FBDA(1),3,FBDA,"FBREJ")
+79 IF FBFILE=162.11
KILL ^FBAA(162.1,FBDA(1),"RX",FBDA,"FBREJ")
+80 IF FBFILE=162.5
KILL ^FBAAI(FBDA,"FBREJ")
End DoDot:1
+81 ;
+82 ; update new batch fields to reflect addition of line item
+83 IF FBRET
Begin DoDot:1
+84 NEW DIERR,FBFDA,FBIC,FBLC,FBTOT
+85 ; get existing data
+86 ; TOTAL DOLLARS
SET FBTOT=$$GET1^DIQ(161.7,FBNB_",",8)
+87 ; INVOICE COUNT
SET FBIC=$$GET1^DIQ(161.7,FBNB_",",9)
+88 ; PAYMENT LINE COUNT
SET FBLC=$$GET1^DIQ(161.7,FBNB_",",10)
+89 ;
+90 ; TOTAL DOLLARS
SET FBFDA(161.7,FBNB_",",8)=FBTOT+FBAP
+91 ; PAYMENT LINE COUNT
SET FBFDA(161.7,FBNB_",",10)=FBLC+1
+92 ; update INVOICE COUNT when appropriate
+93 ; this field is not curently maintained for batch types B2 and B3
+94 ; INVOICE COUNT
IF FBFILE=162.5
SET FBFDA(161.7,FBNB_",",9)=FBIC+1
+95 IF FBFILE=162.11
IF '$GET(FBSKIPIC)
Begin DoDot:2
+96 ; INVOICE COUNT
SET FBFDA(161.7,FBNB_",",9)=FBIC+1
End DoDot:2
+97 ;
+98 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+99 IF $DATA(DIERR)
SET FBRET="0^Error updating data for new batch."
+100 DO CLEAN^DILF
End DoDot:1
+101 ;
+102 ; update old batch if no more rejects pending
+103 IF FBRET
Begin DoDot:1
+104 NEW DIERR,FBFDA
+105 IF FBFILE=162.03
IF $DATA(^FBAAC("AH",FBN))
QUIT
+106 IF FBFILE=162.04
IF $DATA(^FBAAC("AG",FBN))
QUIT
+107 IF FBFILE=162.11
IF $DATA(^FBAA(162.1,"AF",FBN))
QUIT
+108 IF FBFILE=162.5
IF $DATA(^FBAAI("AH",FBN))
QUIT
+109 ; REJECTS PENDING
SET FBFDA(161.7,FBN_",",15)="@"
+110 IF $DATA(FBFDA)
DO FILE^DIE("","FBFDA")
+111 IF $DATA(DIERR)
SET FBRET="0^Error updating data for old batch."
+112 DO CLEAN^DILF
End DoDot:1
+113 ;
+114 QUIT FBRET
+115 ;
+116 ;FBAARR3
