FBAAVR4 ;WOIFO/SAB - FINALIZE BATCH (CONT) ;4/16/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
SETREJ(FBN,FBTYPE,FBIENS,FBIREJ,FBRR,FBRRC) ; Set reject flag for line
; input
; FBN - (conditionally required) Batch IEN, file 161.7
; FBTYPE - (conditionally required) Batch type (B2, B3, B5, or B9)
; FBIENS - (required) IENS of line being rejected, FileMan DBS format
; FBIREJ - (optional) = 1 if reject from interface
; FBRR - (required when not interface reject) free text reject reason
; FBRRC - (required for interface reject), passed by reference
; array of reject codes, FBRRC(#)=code
; where # is an integer greater than 0. e.g. FBRRC(1)="C012"
; returns a value
; =1^batch number^amount paid if successful
; =0^message if unsuccessful
;
; ICRs
; #2053 FILE^DIE, UPDATE^DIE
; #2054 CLEAN^DILF
; #2056 $$GET1^DIQ
;
N FBAP,FBFIELDS,FBFILE,FBRET
S FBRET=1
;
; check inputs
I $G(FBN)="",$G(FBTYPE)="" S FBRET="0^Batch number or type not provided."
I $G(FBIENS)="" S FBRET="0^Line Item IENs not provided."
I $G(FBIREJ),'$O(FBRRC(0)) S FBRET="0^Reject Code not provided."
I '$G(FBIREJ),$G(FBRR)="" S FBRET="0^Reject Reason not provided."
;
; determine batch type if not provided
I FBRET D
. I $G(FBTYPE)="" S FBTYPE=$P($G(^FBAA(161.7,FBN,0)),"^",3) ; TYPE
. I "^B2^B3^B5^B9^"'[(U_FBTYPE_U) S FBRET="0^Batch type invalid."
;
; determine payment/invoice file/sub-file of line item based on type
I FBRET D
. I FBTYPE="B2" S FBFILE="162.04" ; travel
. I FBTYPE="B3" S FBFILE="162.03" ; outpatient or inpatient ancillary
. I FBTYPE="B5" S FBFILE="162.11" ; pharmacy
. I FBTYPE="B9" S FBFILE="162.5" ; inpatient
. I $G(FBFILE)="" S FBRET="0^Could not determine file to update"
;
; 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 sub-file number
. ; piece 8 = date finalized (n/a for 162.11)
. I FBFILE="162.03" S FBFIELDS="7^2^19^20^21^21.3^162.031^5"
. I FBFILE="162.04" S FBFIELDS="1^2^4^5^6^6.3^162.041^7"
. I FBFILE="162.11" S FBFIELDS="13^6.5^17^18^19^19.3^162.111^"
. I FBFILE="162.5" S FBFIELDS="20^8^13^14^15^15.3^162.515^19"
. I $G(FBFIELDS)="" S FBRET="0^Could not determine field numbers"
;
; check status of payment line item
I FBRET D
. S FBN=$$GET1^DIQ(FBFILE,FBIENS,$P(FBFIELDS,"^",1),"I") ; batch IEN
. I $D(DIERR) S FBRET="0^Error retrieving line item data." Q
. I FBN="" D Q ; not in a batch
. . I $$GET1^DIQ(FBFILE,FBIENS,$P(FBFIELDS,"^",3))'="" D Q
. . . S FBRET="0^Line is already flagged as rejected."
. . S FBRET="0^Batch number field on line is a null value."
. S FBAP=$$GET1^DIQ(FBFILE,FBIENS,$P(FBFIELDS,"^",2)) ; amount paid
;
; reject payment line item
I FBRET D
. N DIERR,FBFDA
. S FBFDA(FBFILE,FBIENS,$P(FBFIELDS,"^",1))="@" ; batch number
. S FBFDA(FBFILE,FBIENS,$P(FBFIELDS,"^",3))="P" ; reject status
. I '$G(FBIREJ) S FBFDA(FBFILE,FBIENS,$P(FBFIELDS,"^",4))=FBRR ; reason
. S FBFDA(FBFILE,FBIENS,$P(FBFIELDS,"^",5))=FBN ; old batch number
. S:$G(FBIREJ) FBFDA(FBFILE,FBIENS,$P(FBFIELDS,"^",6))=1 ; interface
. I $P(FBFIELDS,"^",8) D
. . ; field will already be null except when post voucher reject msg
. . S FBFDA(FBFILE,FBIENS,$P(FBFIELDS,"^",8))="@" ; date finalized
. ;
. D FILE^DIE("","FBFDA")
. D CLEAN^DILF
;
; save reject codes for interface reject
I FBRET,$G(FBIREJ) D
. N DIERR,FBFDA,FBI
. ; loop thru reject codes
. S FBI=0 F S FBI=$O(FBRRC(FBI)) Q:'FBI D
. . Q:FBRRC(FBI)=""
. . S FBFDA($P(FBFIELDS,"^",7),"+"_FBI_","_FBIENS,.01)=FBRRC(FBI)
. ;
. D UPDATE^DIE("","FBFDA")
. D CLEAN^DILF
;
; update batch data to reflect rejected line item
I FBRET D
. N DIERR,FBFDA,FBIC,FBLC,FBTOT
. ; get existing data
. S FBTOT=$$GET1^DIQ(161.7,FBN_",",8) ; TOTAL DOLLARS
. S FBIC=$$GET1^DIQ(161.7,FBN_",",9) ; INVOICE COUNT
. S FBLC=$$GET1^DIQ(161.7,FBN_",",10) ; PAYMENT LINE COUNT
. ;
. S FBFDA(161.7,FBN_",",8)=FBTOT-FBAP ; TOTAL DOLLARS
. S FBFDA(161.7,FBN_",",10)=FBLC-1 ; PAYMENT LINE COUNT
. S FBFDA(161.7,FBN_",",15)="Y" ; REJECTS PENDING
. ; 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,FBN_",",9)=FBIC-1 ; INVOICE COUNT
. I FBFILE=162.11 D
. . ; quit if any lines from the pharmacy invoice remain on the batch
. . Q:$O(^FBAA(162.1,"AE",FBN,$P(FBIENS,",",2),0))
. . S FBFDA(161.7,FBN_",",9)=FBIC-1 ; INVOICE COUNT
. ;
. D FILE^DIE("","FBFDA")
. D CLEAN^DILF
;
; if success add batch IEN and amount paid to return value
I FBRET S FBRET=FBRET_"^"_FBN_"^"_FBAP
Q FBRET
;
;FBAAVR4
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBAAVR4 5077 printed Dec 13, 2024@01:57:15 Page 2
FBAAVR4 ;WOIFO/SAB - FINALIZE BATCH (CONT) ;4/16/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 ;
SETREJ(FBN,FBTYPE,FBIENS,FBIREJ,FBRR,FBRRC) ; Set reject flag for line
+1 ; input
+2 ; FBN - (conditionally required) Batch IEN, file 161.7
+3 ; FBTYPE - (conditionally required) Batch type (B2, B3, B5, or B9)
+4 ; FBIENS - (required) IENS of line being rejected, FileMan DBS format
+5 ; FBIREJ - (optional) = 1 if reject from interface
+6 ; FBRR - (required when not interface reject) free text reject reason
+7 ; FBRRC - (required for interface reject), passed by reference
+8 ; array of reject codes, FBRRC(#)=code
+9 ; where # is an integer greater than 0. e.g. FBRRC(1)="C012"
+10 ; returns a value
+11 ; =1^batch number^amount paid if successful
+12 ; =0^message if unsuccessful
+13 ;
+14 ; ICRs
+15 ; #2053 FILE^DIE, UPDATE^DIE
+16 ; #2054 CLEAN^DILF
+17 ; #2056 $$GET1^DIQ
+18 ;
+19 NEW FBAP,FBFIELDS,FBFILE,FBRET
+20 SET FBRET=1
+21 ;
+22 ; check inputs
+23 IF $GET(FBN)=""
IF $GET(FBTYPE)=""
SET FBRET="0^Batch number or type not provided."
+24 IF $GET(FBIENS)=""
SET FBRET="0^Line Item IENs not provided."
+25 IF $GET(FBIREJ)
IF '$ORDER(FBRRC(0))
SET FBRET="0^Reject Code not provided."
+26 IF '$GET(FBIREJ)
IF $GET(FBRR)=""
SET FBRET="0^Reject Reason not provided."
+27 ;
+28 ; determine batch type if not provided
+29 IF FBRET
Begin DoDot:1
+30 ; TYPE
IF $GET(FBTYPE)=""
SET FBTYPE=$PIECE($GET(^FBAA(161.7,FBN,0)),"^",3)
+31 IF "^B2^B3^B5^B9^"'[(U_FBTYPE_U)
SET FBRET="0^Batch type invalid."
End DoDot:1
+32 ;
+33 ; determine payment/invoice file/sub-file of line item based on type
+34 IF FBRET
Begin DoDot:1
+35 ; travel
IF FBTYPE="B2"
SET FBFILE="162.04"
+36 ; outpatient or inpatient ancillary
IF FBTYPE="B3"
SET FBFILE="162.03"
+37 ; pharmacy
IF FBTYPE="B5"
SET FBFILE="162.11"
+38 ; inpatient
IF FBTYPE="B9"
SET FBFILE="162.5"
+39 IF $GET(FBFILE)=""
SET FBRET="0^Could not determine file to update"
End DoDot:1
+40 ;
+41 ; determine field numbers based on file
+42 IF FBRET
Begin DoDot:1
+43 ; FBFIELDS will contain the numbers of the following fields/sub-file
+44 ; piece 1 = batch number
+45 ; piece 2 = amount paid
+46 ; piece 3 = reject status
+47 ; piece 4 = reject reason
+48 ; piece 5 = old batch number
+49 ; piece 6 = interface reject
+50 ; piece 7 = reject code sub-file number
+51 ; piece 8 = date finalized (n/a for 162.11)
+52 IF FBFILE="162.03"
SET FBFIELDS="7^2^19^20^21^21.3^162.031^5"
+53 IF FBFILE="162.04"
SET FBFIELDS="1^2^4^5^6^6.3^162.041^7"
+54 IF FBFILE="162.11"
SET FBFIELDS="13^6.5^17^18^19^19.3^162.111^"
+55 IF FBFILE="162.5"
SET FBFIELDS="20^8^13^14^15^15.3^162.515^19"
+56 IF $GET(FBFIELDS)=""
SET FBRET="0^Could not determine field numbers"
End DoDot:1
+57 ;
+58 ; check status of payment line item
+59 IF FBRET
Begin DoDot:1
+60 ; batch IEN
SET FBN=$$GET1^DIQ(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",1),"I")
+61 IF $DATA(DIERR)
SET FBRET="0^Error retrieving line item data."
QUIT
+62 ; not in a batch
IF FBN=""
Begin DoDot:2
+63 IF $$GET1^DIQ(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",3))'=""
Begin DoDot:3
+64 SET FBRET="0^Line is already flagged as rejected."
End DoDot:3
QUIT
+65 SET FBRET="0^Batch number field on line is a null value."
End DoDot:2
QUIT
+66 ; amount paid
SET FBAP=$$GET1^DIQ(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",2))
End DoDot:1
+67 ;
+68 ; reject payment line item
+69 IF FBRET
Begin DoDot:1
+70 NEW DIERR,FBFDA
+71 ; batch number
SET FBFDA(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",1))="@"
+72 ; reject status
SET FBFDA(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",3))="P"
+73 ; reason
IF '$GET(FBIREJ)
SET FBFDA(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",4))=FBRR
+74 ; old batch number
SET FBFDA(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",5))=FBN
+75 ; interface
if $GET(FBIREJ)
SET FBFDA(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",6))=1
+76 IF $PIECE(FBFIELDS,"^",8)
Begin DoDot:2
+77 ; field will already be null except when post voucher reject msg
+78 ; date finalized
SET FBFDA(FBFILE,FBIENS,$PIECE(FBFIELDS,"^",8))="@"
End DoDot:2
+79 ;
+80 DO FILE^DIE("","FBFDA")
+81 DO CLEAN^DILF
End DoDot:1
+82 ;
+83 ; save reject codes for interface reject
+84 IF FBRET
IF $GET(FBIREJ)
Begin DoDot:1
+85 NEW DIERR,FBFDA,FBI
+86 ; loop thru reject codes
+87 SET FBI=0
FOR
SET FBI=$ORDER(FBRRC(FBI))
if 'FBI
QUIT
Begin DoDot:2
+88 if FBRRC(FBI)=""
QUIT
+89 SET FBFDA($PIECE(FBFIELDS,"^",7),"+"_FBI_","_FBIENS,.01)=FBRRC(FBI)
End DoDot:2
+90 ;
+91 DO UPDATE^DIE("","FBFDA")
+92 DO CLEAN^DILF
End DoDot:1
+93 ;
+94 ; update batch data to reflect rejected line item
+95 IF FBRET
Begin DoDot:1
+96 NEW DIERR,FBFDA,FBIC,FBLC,FBTOT
+97 ; get existing data
+98 ; TOTAL DOLLARS
SET FBTOT=$$GET1^DIQ(161.7,FBN_",",8)
+99 ; INVOICE COUNT
SET FBIC=$$GET1^DIQ(161.7,FBN_",",9)
+100 ; PAYMENT LINE COUNT
SET FBLC=$$GET1^DIQ(161.7,FBN_",",10)
+101 ;
+102 ; TOTAL DOLLARS
SET FBFDA(161.7,FBN_",",8)=FBTOT-FBAP
+103 ; PAYMENT LINE COUNT
SET FBFDA(161.7,FBN_",",10)=FBLC-1
+104 ; REJECTS PENDING
SET FBFDA(161.7,FBN_",",15)="Y"
+105 ; update INVOICE COUNT when appropriate
+106 ; this field is not curently maintained for batch types B2 and B3
+107 ; INVOICE COUNT
IF FBFILE=162.5
SET FBFDA(161.7,FBN_",",9)=FBIC-1
+108 IF FBFILE=162.11
Begin DoDot:2
+109 ; quit if any lines from the pharmacy invoice remain on the batch
+110 if $ORDER(^FBAA(162.1,"AE",FBN,$PIECE(FBIENS,",",2),0))
QUIT
+111 ; INVOICE COUNT
SET FBFDA(161.7,FBN_",",9)=FBIC-1
End DoDot:2
+112 ;
+113 DO FILE^DIE("","FBFDA")
+114 DO CLEAN^DILF
End DoDot:1
+115 ;
+116 ; if success add batch IEN and amount paid to return value
+117 IF FBRET
SET FBRET=FBRET_"^"_FBN_"^"_FBAP
+118 QUIT FBRET
+119 ;
+120 ;FBAAVR4
