FB1358 ;WOIFO/SAB - IFCAP 1358 OBLIGATION UTILITIES ;3/13/2012
;;3.5;FEE BASIS;**132**;JAN 30, 1995;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
CHK1358(FBAAOB) ; Determine if 1358 obligation is available for posting
; input
; FBAAOB - (required) full obligation number including station
; (e.g. 500-C20001)
; returns a value
; = 1 if 1358 is available for posting
; = 0^message if 1358 is not available for posting
;
N FBRET,PRCS,X,Y
S FBRET="0^1358 number not provided!"
I $G(FBAAOB)'="" D
. S PRCS("X")=FBAAOB
. S PRCS("TYPE")="FB"
. D EN3^PRCS58
. I Y=-1 S FBRET="0^1358 not available for posting!"
. E S FBRET=1
;
Q FBRET
;
FND424(FB424ID) ; Find File 424 IEN
; input
; FB424ID - (required) INTERFACE ID value of entry in file 424
; returns file 424 internal entry number or null value if not found
;
Q $S($G(FB424ID)]"":$O(^PRC(424,"E",FB424ID,0)),1:"")
;
POSTBAT(FBN,FBAAMT,FBACT,FBSKIP) ; Post to 1358 obligation by batch
; This API is called to update an existing IFCAP authorization on a
; 1358 obligation when the IFCAP authorization is by fee batch.
; input
; FBN - (required) Batch IEN, file 161.7
; FBAAMT - (required) dollar amount
; FBACT - (required) action, value of "R" or "D"
; = "R" if called when payment flagged as rejected
; = "D" if called when reject flag is deleted
; FBSKIP (optional) =1 to skip control point access check
; returns value
; = 1 if success
; = 0^message if unsuccessful
;
N FB424,FBAAB,FBAAON,FBAASN,FBRET
S FBRET=1 ; initialize return value
;
; verify inputs
I $G(FBN)="" S FBRET="0^Batch IEN was not provided."
I $G(FBAAMT)="" S FBRET="0^Amount was not provided."
I "^R^D^"'[(U_$G(FBACT)_U) S FBRET="0^Invalid action code."
;
; get data from batch file
I FBRET D
. N FBX
. S FBX=$G(^FBAA(161.7,FBN,0))
. S FBAAB=$P(FBX,U,1) ; NUMBER
. S FBAAON=$P(FBX,U,2) ; OBLIGATION NUMBER
. S FBAASN=$P(FBX,U,8) ; STATION NUMBER
. I FBAAB=""!(FBAAON="")!(FBAASN="") S FBRET="0^Invalid Batch Data for IEN "_FBN
;
; check if 1358 available for posting
I FBRET D
. N FBX
. S FBX=$$CHK1358(FBAASN_"-"_FBAAON)
. I 'FBX S FBRET=FBX
;
; determine 1358 daily record entry to update
I FBRET D
. S FB424=$$FND424(FBN)
. I FB424="" S FBRET="0^File 424 entry not found."
;
; post amount to IFCAP
I FBRET D
. N FBCOMM,PRCSX,Y
. ; determine comment
. I FBACT="R" S FBCOMM="Rejected items from batch "_FBAAB
. I FBACT="D" S FBCOMM="Deleted reject flags from batch "_FBAAB
. ; if action is reject then make amount negative to add dollars back
. I FBACT="R",FBAAMT>0 S FBAAMT=-FBAAMT
. ;
. S PRCSX=FB424_"^"_$$NOW^XLFDT_"^"_FBAAMT_"^"_$G(FBCOMM)_"^1"
. I $G(FBSKIP)=1 S $P(PRCSX,"^",7)="1"
. D ^PRCS58CC
. I Y'=1 S FBRET="0^"_$P(Y,"^",2)_"."
;
Q FBRET
;
POSTINV(FBN,FBI,FBACT,FBSKIP) ; Post to 1358 obligation by invoice
; This API is called to update an existing IFCAP authorization on a
; 1358 obligation when the IFCAP authorization is posted by invoice.
; input
; FBN - (required) Batch IEN, file 161.7
; FBI - (required) Invoice IEN, file 162.5
; FBACT - (required) action, value of "R" or "D"
; = "R" if called when payment flagged as rejected
; = "D" if called when reject flag is deleted
; FBSKIP (optional) =1 to skip control point access check
; returns value
; = 1 if success
; = 0^message if unsuccessful
;
N FB424,FBAAB,FBAAMT,FBAAON,FBAASN,FBDFN,FBII78,FBMM,FBPROG,FBRET
S FBRET=1 ; initialize return value
;
; verify inputs
I $G(FBN)="" S FBRET="0^Batch IEN was not provided."
I $G(FBI)="" S FBRET="0^Invoice IEN was not provided."
I "^R^D^"'[(U_$G(FBACT)_U) S FBRET="0^Invalid action code."
;
; get data from batch file
I FBRET D
. N FBX
. S FBX=$G(^FBAA(161.7,FBN,0))
. S FBAAB=$P(FBX,U,1) ; NUMBER
. S FBAASN=$P(FBX,U,8) ; STATION NUMBER
. S FBAAON=$P(FBX,U,2) ; OBLIGATION NUMBER
. I FBAAB=""!(FBAAON="")!(FBAASN="") S FBRET="0^Invalid Batch Data for IEN "_FBN
;
; check if 1358 available for posting
I FBRET D
. N FBX
. S FBX=$$CHK1358(FBAASN_"-"_FBAAON)
. I 'FBX S FBRET=FBX
;
; get invoice data
I FBRET D
. N FBX
. S FBX=$G(^FBAAI(FBI,0))
. S FBDFN=$P(FBX,"^",4) ; VETERAN
. S FBPROG=$P(FBX,"^",12) ; FEE PROGRAM
. S FBAAMT=$P(FBX,"^",9) ; AMOUNT PAID
. S FBII78=$P(FBX,"^",5) ; ASSOCIATED 7078/583
. I FBDFN=""!(FBPROG="")!(FBAAMT="")!(FBII78="") S FBRET="0^Invalid invoice data for IEN "_FBI
. ; if nursing home invoice get month
. I FBRET,FBPROG=7 D
. . S FBMM=$E($P(FBX,"^",7),4,5) ; 2 digit month from TREATMENT TO DATE
. . I FBMM="" S FBRET="0^Invalid invoice data for IEN "_FBI
;
I FBRET,FBII78["FB583" D
. S FBRET="0^Invoice is associated with an unauthorized claim."
;
; determine 1358 daily record entry to update
I FBRET D
. N FBX
. ; build interface ID
. S FBX=FBDFN_";"_+FBII78_";"_FBAAON
. I FBPROG=7 S FBX=FBX_";"_FBMM
. S FB424=$$FND424(FBX)
. I FB424="" S FBRET="0^File 424 entry not found."
;
; post amount to IFCAP
I FBRET D
. N FBCOMM,PRCSX,Y
. ; determine comment
. I FBACT="R" S FBCOMM="Rejected items from batch "_FBAAB
. I FBACT="D" S FBCOMM="Deleted reject flags from batch "_FBAAB
. ; if action is reject then make amount negative to add dollars back
. I FBACT="R",FBAAMT>0 S FBAAMT=-FBAAMT
. ;
. S PRCSX=FB424_"^"_$$NOW^XLFDT_"^"_FBAAMT_"^"_$G(FBCOMM)_"^1"
. I $G(FBSKIP)=1 S $P(PRCSX,"^",7)="1"
. D ^PRCS58CC
. I Y'=1 S FBRET="0^"_$P(Y,"^",2)_"."
;
Q FBRET
;
;FB1358
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFB1358 5692 printed Nov 22, 2024@17:04:55 Page 2
FB1358 ;WOIFO/SAB - IFCAP 1358 OBLIGATION UTILITIES ;3/13/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 ;
CHK1358(FBAAOB) ; Determine if 1358 obligation is available for posting
+1 ; input
+2 ; FBAAOB - (required) full obligation number including station
+3 ; (e.g. 500-C20001)
+4 ; returns a value
+5 ; = 1 if 1358 is available for posting
+6 ; = 0^message if 1358 is not available for posting
+7 ;
+8 NEW FBRET,PRCS,X,Y
+9 SET FBRET="0^1358 number not provided!"
+10 IF $GET(FBAAOB)'=""
Begin DoDot:1
+11 SET PRCS("X")=FBAAOB
+12 SET PRCS("TYPE")="FB"
+13 DO EN3^PRCS58
+14 IF Y=-1
SET FBRET="0^1358 not available for posting!"
+15 IF '$TEST
SET FBRET=1
End DoDot:1
+16 ;
+17 QUIT FBRET
+18 ;
FND424(FB424ID) ; Find File 424 IEN
+1 ; input
+2 ; FB424ID - (required) INTERFACE ID value of entry in file 424
+3 ; returns file 424 internal entry number or null value if not found
+4 ;
+5 QUIT $SELECT($GET(FB424ID)]"":$ORDER(^PRC(424,"E",FB424ID,0)),1:"")
+6 ;
POSTBAT(FBN,FBAAMT,FBACT,FBSKIP) ; Post to 1358 obligation by batch
+1 ; This API is called to update an existing IFCAP authorization on a
+2 ; 1358 obligation when the IFCAP authorization is by fee batch.
+3 ; input
+4 ; FBN - (required) Batch IEN, file 161.7
+5 ; FBAAMT - (required) dollar amount
+6 ; FBACT - (required) action, value of "R" or "D"
+7 ; = "R" if called when payment flagged as rejected
+8 ; = "D" if called when reject flag is deleted
+9 ; FBSKIP (optional) =1 to skip control point access check
+10 ; returns value
+11 ; = 1 if success
+12 ; = 0^message if unsuccessful
+13 ;
+14 NEW FB424,FBAAB,FBAAON,FBAASN,FBRET
+15 ; initialize return value
SET FBRET=1
+16 ;
+17 ; verify inputs
+18 IF $GET(FBN)=""
SET FBRET="0^Batch IEN was not provided."
+19 IF $GET(FBAAMT)=""
SET FBRET="0^Amount was not provided."
+20 IF "^R^D^"'[(U_$GET(FBACT)_U)
SET FBRET="0^Invalid action code."
+21 ;
+22 ; get data from batch file
+23 IF FBRET
Begin DoDot:1
+24 NEW FBX
+25 SET FBX=$GET(^FBAA(161.7,FBN,0))
+26 ; NUMBER
SET FBAAB=$PIECE(FBX,U,1)
+27 ; OBLIGATION NUMBER
SET FBAAON=$PIECE(FBX,U,2)
+28 ; STATION NUMBER
SET FBAASN=$PIECE(FBX,U,8)
+29 IF FBAAB=""!(FBAAON="")!(FBAASN="")
SET FBRET="0^Invalid Batch Data for IEN "_FBN
End DoDot:1
+30 ;
+31 ; check if 1358 available for posting
+32 IF FBRET
Begin DoDot:1
+33 NEW FBX
+34 SET FBX=$$CHK1358(FBAASN_"-"_FBAAON)
+35 IF 'FBX
SET FBRET=FBX
End DoDot:1
+36 ;
+37 ; determine 1358 daily record entry to update
+38 IF FBRET
Begin DoDot:1
+39 SET FB424=$$FND424(FBN)
+40 IF FB424=""
SET FBRET="0^File 424 entry not found."
End DoDot:1
+41 ;
+42 ; post amount to IFCAP
+43 IF FBRET
Begin DoDot:1
+44 NEW FBCOMM,PRCSX,Y
+45 ; determine comment
+46 IF FBACT="R"
SET FBCOMM="Rejected items from batch "_FBAAB
+47 IF FBACT="D"
SET FBCOMM="Deleted reject flags from batch "_FBAAB
+48 ; if action is reject then make amount negative to add dollars back
+49 IF FBACT="R"
IF FBAAMT>0
SET FBAAMT=-FBAAMT
+50 ;
+51 SET PRCSX=FB424_"^"_$$NOW^XLFDT_"^"_FBAAMT_"^"_$G(FBCOMM)_"^1"
+52 IF $GET(FBSKIP)=1
SET $PIECE(PRCSX,"^",7)="1"
+53 DO ^PRCS58CC
+54 IF Y'=1
SET FBRET="0^"_$PIECE(Y,"^",2)_"."
End DoDot:1
+55 ;
+56 QUIT FBRET
+57 ;
POSTINV(FBN,FBI,FBACT,FBSKIP) ; Post to 1358 obligation by invoice
+1 ; This API is called to update an existing IFCAP authorization on a
+2 ; 1358 obligation when the IFCAP authorization is posted by invoice.
+3 ; input
+4 ; FBN - (required) Batch IEN, file 161.7
+5 ; FBI - (required) Invoice IEN, file 162.5
+6 ; FBACT - (required) action, value of "R" or "D"
+7 ; = "R" if called when payment flagged as rejected
+8 ; = "D" if called when reject flag is deleted
+9 ; FBSKIP (optional) =1 to skip control point access check
+10 ; returns value
+11 ; = 1 if success
+12 ; = 0^message if unsuccessful
+13 ;
+14 NEW FB424,FBAAB,FBAAMT,FBAAON,FBAASN,FBDFN,FBII78,FBMM,FBPROG,FBRET
+15 ; initialize return value
SET FBRET=1
+16 ;
+17 ; verify inputs
+18 IF $GET(FBN)=""
SET FBRET="0^Batch IEN was not provided."
+19 IF $GET(FBI)=""
SET FBRET="0^Invoice IEN was not provided."
+20 IF "^R^D^"'[(U_$GET(FBACT)_U)
SET FBRET="0^Invalid action code."
+21 ;
+22 ; get data from batch file
+23 IF FBRET
Begin DoDot:1
+24 NEW FBX
+25 SET FBX=$GET(^FBAA(161.7,FBN,0))
+26 ; NUMBER
SET FBAAB=$PIECE(FBX,U,1)
+27 ; STATION NUMBER
SET FBAASN=$PIECE(FBX,U,8)
+28 ; OBLIGATION NUMBER
SET FBAAON=$PIECE(FBX,U,2)
+29 IF FBAAB=""!(FBAAON="")!(FBAASN="")
SET FBRET="0^Invalid Batch Data for IEN "_FBN
End DoDot:1
+30 ;
+31 ; check if 1358 available for posting
+32 IF FBRET
Begin DoDot:1
+33 NEW FBX
+34 SET FBX=$$CHK1358(FBAASN_"-"_FBAAON)
+35 IF 'FBX
SET FBRET=FBX
End DoDot:1
+36 ;
+37 ; get invoice data
+38 IF FBRET
Begin DoDot:1
+39 NEW FBX
+40 SET FBX=$GET(^FBAAI(FBI,0))
+41 ; VETERAN
SET FBDFN=$PIECE(FBX,"^",4)
+42 ; FEE PROGRAM
SET FBPROG=$PIECE(FBX,"^",12)
+43 ; AMOUNT PAID
SET FBAAMT=$PIECE(FBX,"^",9)
+44 ; ASSOCIATED 7078/583
SET FBII78=$PIECE(FBX,"^",5)
+45 IF FBDFN=""!(FBPROG="")!(FBAAMT="")!(FBII78="")
SET FBRET="0^Invalid invoice data for IEN "_FBI
+46 ; if nursing home invoice get month
+47 IF FBRET
IF FBPROG=7
Begin DoDot:2
+48 ; 2 digit month from TREATMENT TO DATE
SET FBMM=$EXTRACT($PIECE(FBX,"^",7),4,5)
+49 IF FBMM=""
SET FBRET="0^Invalid invoice data for IEN "_FBI
End DoDot:2
End DoDot:1
+50 ;
+51 IF FBRET
IF FBII78["FB583"
Begin DoDot:1
+52 SET FBRET="0^Invoice is associated with an unauthorized claim."
End DoDot:1
+53 ;
+54 ; determine 1358 daily record entry to update
+55 IF FBRET
Begin DoDot:1
+56 NEW FBX
+57 ; build interface ID
+58 SET FBX=FBDFN_";"_+FBII78_";"_FBAAON
+59 IF FBPROG=7
SET FBX=FBX_";"_FBMM
+60 SET FB424=$$FND424(FBX)
+61 IF FB424=""
SET FBRET="0^File 424 entry not found."
End DoDot:1
+62 ;
+63 ; post amount to IFCAP
+64 IF FBRET
Begin DoDot:1
+65 NEW FBCOMM,PRCSX,Y
+66 ; determine comment
+67 IF FBACT="R"
SET FBCOMM="Rejected items from batch "_FBAAB
+68 IF FBACT="D"
SET FBCOMM="Deleted reject flags from batch "_FBAAB
+69 ; if action is reject then make amount negative to add dollars back
+70 IF FBACT="R"
IF FBAAMT>0
SET FBAAMT=-FBAAMT
+71 ;
+72 SET PRCSX=FB424_"^"_$$NOW^XLFDT_"^"_FBAAMT_"^"_$G(FBCOMM)_"^1"
+73 IF $GET(FBSKIP)=1
SET $PIECE(PRCSX,"^",7)="1"
+74 DO ^PRCS58CC
+75 IF Y'=1
SET FBRET="0^"_$PIECE(Y,"^",2)_"."
End DoDot:1
+76 ;
+77 QUIT FBRET
+78 ;
+79 ;FB1358
