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

FBAARR3.m

Go to the documentation of this file.
  1. FBAARR3 ;WOIFO/SAB - REINITIATE REJECTED LINE ITEMS ;4/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. ; ICRs
  1. ; #2053 FILE^DIE
  1. ; #2054 CLEAN^DILF, DA^DILF
  1. ; #2056 $$GET1^DIQ, GETS^DIQ
  1. ;
  1. DELREJ(FBFILE,FBPIENS,FBNB) ; Delete Reject Flag
  1. ; input
  1. ; FBFILE - payment file (162.03, 162.04, 162.11, 162.5)
  1. ; FBPIENS - IEN of payment line in file, FileMan DBS format
  1. ; FBNB - IEN of new batch, only pass when re-initiate
  1. ; return value
  1. ; =1 when successfully processed
  1. ; =0^message when not
  1. ;
  1. N FBAP,FBFIELDS,FBN,FBRET,FBSKIPIC
  1. S FBRET=1
  1. ;
  1. ; verify inputs
  1. I $G(FBFILE)="" S FBRET="0^File number not provided."
  1. I $G(FBPIENS)="" S FBRET="0^Line Item IENs not provided."
  1. I $G(FBNB),"^O^A^"'[("^"_$$GET1^DIQ(161.7,FBNB_",",11,"I")_"^") D
  1. . S FBRET="0^New batch status is not OPEN or ASSIGNED PRICE."
  1. ;
  1. ; determine field numbers based on file
  1. I FBRET D
  1. . ; FBFIELDS will contain the numbers of the following fields/sub-file
  1. . ; piece 1 = batch number
  1. . ; piece 2 = amount paid
  1. . ; piece 3 = reject status
  1. . ; piece 4 = reject reason
  1. . ; piece 5 = old batch number
  1. . ; piece 6 = interface reject
  1. . ; piece 7 = reject code
  1. . ; piece 8 = reject code sub-file number
  1. . I FBFILE="162.03" S FBFIELDS="7^2^19^20^21^21.3^21.6^162.031"
  1. . I FBFILE="162.04" S FBFIELDS="1^2^4^5^6^6.3^6.6^162.041"
  1. . I FBFILE="162.11" S FBFIELDS="13^6.5^17^18^19^19.3^19.6^162.111"
  1. . I FBFILE="162.5" S FBFIELDS="20^8^13^14^15^15.3^15.6^162.515"
  1. . I $G(FBFIELDS)="" S FBRET="0^Could not determine field numbers"
  1. ;
  1. ; get line item data
  1. I FBRET D
  1. . S FBAP=$$GET1^DIQ(FBFILE,FBPIENS,$P(FBFIELDS,"^",2)) ; amount paid
  1. . S FBN=$$GET1^DIQ(FBFILE,FBPIENS,$P(FBFIELDS,"^",5),"I") ; old batch
  1. . I FBN="" S FBRET="0^OLD BATCH NUMBER is null, Line is not rejected."
  1. ;
  1. ; restore to original batch when input FBNB is null (not re-initiate)
  1. I FBRET D
  1. . S:$G(FBNB)="" FBNB=FBN
  1. ;
  1. ; if file is 162.11 and invoice already has a line on the batch then
  1. ; set flag to prevent increase to the batch invoice count
  1. I FBRET,FBFILE=162.11 D
  1. . I $O(^FBAA(162.1,"AE",FBNB,$P(FBPIENS,",",2),0)) S FBSKIPIC=1
  1. ;
  1. ; update line item
  1. I FBRET D
  1. . N DIERR,FBFDA,FBRIENS,FBX
  1. . S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",1))=FBNB ; batch number
  1. . S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",3))="@" ; reject status
  1. . S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",4))="@" ; reject reason
  1. . S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",5))="@" ; old batch number
  1. . S FBFDA(FBFILE,FBPIENS,$P(FBFIELDS,"^",6))="@" ; interface reject
  1. . ;
  1. . ; get list of entries in REJECT CODE multiple
  1. . D GETS^DIQ(FBFILE,FBPIENS,$P(FBFIELDS,"^",7)_"*","","FBX")
  1. . ;
  1. . ; loop thru REJECT CODE entries
  1. . S FBRIENS=""
  1. . F S FBRIENS=$O(FBX($P(FBFIELDS,"^",8),FBRIENS)) Q:FBRIENS="" D
  1. . . S FBFDA($P(FBFIELDS,"^",8),FBRIENS,.01)="@" ; REJECT CODE
  1. . ;
  1. . D FILE^DIE("","FBFDA")
  1. . I $D(DIERR) S FBRET="0^Error updating line item."
  1. . D CLEAN^DILF
  1. ;
  1. I FBRET D
  1. . ; the software often checks $DATA of the "FBREJ" node to determine
  1. . ; if a line item is flagged as rejected. To ensure this checks works
  1. . ; correctly the node will be killed.
  1. . N FBDA
  1. . D DA^DILF(FBPIENS,.FBDA)
  1. . I FBFILE=162.03 K ^FBAAC(FBDA(3),1,FBDA(2),1,FBDA(1),1,FBDA,"FBREJ")
  1. . I FBFILE=162.04 K ^FBAAC(FBDA(1),3,FBDA,"FBREJ")
  1. . I FBFILE=162.11 K ^FBAA(162.1,FBDA(1),"RX",FBDA,"FBREJ")
  1. . I FBFILE=162.5 K ^FBAAI(FBDA,"FBREJ")
  1. ;
  1. ; update new batch fields to reflect addition of line item
  1. I FBRET D
  1. . N DIERR,FBFDA,FBIC,FBLC,FBTOT
  1. . ; get existing data
  1. . S FBTOT=$$GET1^DIQ(161.7,FBNB_",",8) ; TOTAL DOLLARS
  1. . S FBIC=$$GET1^DIQ(161.7,FBNB_",",9) ; INVOICE COUNT
  1. . S FBLC=$$GET1^DIQ(161.7,FBNB_",",10) ; PAYMENT LINE COUNT
  1. . ;
  1. . S FBFDA(161.7,FBNB_",",8)=FBTOT+FBAP ; TOTAL DOLLARS
  1. . S FBFDA(161.7,FBNB_",",10)=FBLC+1 ; PAYMENT LINE COUNT
  1. . ; update INVOICE COUNT when appropriate
  1. . ; this field is not curently maintained for batch types B2 and B3
  1. . I FBFILE=162.5 S FBFDA(161.7,FBNB_",",9)=FBIC+1 ; INVOICE COUNT
  1. . I FBFILE=162.11,'$G(FBSKIPIC) D
  1. . . S FBFDA(161.7,FBNB_",",9)=FBIC+1 ; INVOICE COUNT
  1. . ;
  1. . I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. . I $D(DIERR) S FBRET="0^Error updating data for new batch."
  1. . D CLEAN^DILF
  1. ;
  1. ; update old batch if no more rejects pending
  1. I FBRET D
  1. . N DIERR,FBFDA
  1. . I FBFILE=162.03,$D(^FBAAC("AH",FBN)) Q
  1. . I FBFILE=162.04,$D(^FBAAC("AG",FBN)) Q
  1. . I FBFILE=162.11,$D(^FBAA(162.1,"AF",FBN)) Q
  1. . I FBFILE=162.5,$D(^FBAAI("AH",FBN)) Q
  1. . S FBFDA(161.7,FBN_",",15)="@" ; REJECTS PENDING
  1. . I $D(FBFDA) D FILE^DIE("","FBFDA")
  1. . I $D(DIERR) S FBRET="0^Error updating data for old batch."
  1. . D CLEAN^DILF
  1. ;
  1. Q FBRET
  1. ;
  1. ;FBAARR3