- 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 Jan 18, 2025@02:57:45 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