FBFHLD9 ;OIFO/SAB-GET DATA FOR INPATIENT INVOICE ;9/9/2003
;;3.5;FEE BASIS;**61,122**;JUNE 6, 2011;Build 8
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
EN ;
; input
; FBAAIN - invoice number
; output
; If transaction type = "X" then only * items are output
; Claim Level Data
; FBD(0,"AMT") = Amount Disbursed^Amount Interest
; *FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
; FBD(0,"DAYS) = Covered Days
; FBD(0,"DRG") = DRG^DRG Weight
; FBD(0,"DT") = Invoice Date
; *FBD(0,"FPPS") = FPPS Claim ID
; *FBD(0,"INV") = Invoice #^Transaction Type^Station #
;
; Line Level Data
; FBD(1,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1
; FBD(1,"AMT") = Amount Claimed^Amount Paid
; FBD(1,"CK") = Check Number^Check Date^Payment Method
; FBD(1,"835") = Routing Number^Financial Institution^^Account Number ; FB*3.5*122
; FBD(1,"DT") = Start Date^End Date
; FBD(1,"FPPS") = FPPS Line Item
; FBD(1,"RMK") = Remittance Remark1,Remittance Remark2
;
; If exceptions for invoice
; ^TMP($J,"FBE",FBAAIN,seq number)=message
; If warnings for invoice
; ^TMP($J,"FBW",FBAAIN,seq number)=message
;
; initialize variables
N DA,FBC,FBI,FBIENS,FBSTA,FBTTYP,FBY
K FBD
;
S DA=FBAAIN
S FBIENS=DA_","
F FBI=0,2,3,"FBREJ" S FBY(FBI)=$G(^FBAAI(DA,FBI))
Q:'$$CKLNST() ; skip line if status not OK to transmit
S FBC=1
D INVOICE
I FBTTYP="C" D LINE
Q
;
INVOICE ; determine invoice data
; FBD(0,"AMT") = Amount Disbursed^Amount Interest
; FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
; FBD(0,"DAYS")
; FBD(0,"DRG")
; FBD(0,"DT") = Invoice Date
; FBD(0,"FPPS") = FPPS Claim ID
; FBD(0,"INV") = Invoice #^Transaction Type^Station #
; FBSTA = station number
; FBTTYP = transaction type (C or X)
;
N FBDT,FBOB,FBX
; determine Transaction Type (based on CANCELLATION DATE)
S FBTTYP=$S($P(FBY(2),U,5)]"":"X",1:"C")
;
; determine station number
S FBSTA=$$STANO^FBFHLU($P(FBY(0),U,17))
;
;INV
S FBD(0,"INV")=FBAAIN_U_FBTTYP_U_FBSTA
;
;FPPS
S FBD(0,"FPPS")=$P(FBY(3),U)
;
;CAN
; if cancel then get cancel data
I FBTTYP="X" D Q
. S FBD(0,"CAN")=$P(FBY(2),U,5)_U_$$GET1^DIQ(162.5,FBIENS,"50:1")_U_$P(FBY(2),U,7)
;
;AMT
S FBD(0,"AMT")="0^0" ; initialize sums
;
;DT
; determine invoice date
; (date finalized or date paid or date supervisor closed batch)
S FBDT=$P(FBY(0),U,16) ; date finalized
I FBDT="" S FBDT=$P(FBY(2),U) ; date paid
I FBDT="",$P(FBY(0),U,17) S FBDT=$P(^FBAA(161.7,$P(FBY(0),U,17),0),U,6) ; date supv closed
S FBD(0,"DT")=FBDT
;
;DAYS
S FBD(0,"DAYS")=+$P(FBY(2),U,10)
;
;DRG
S FBX=$$GET1^DIQ(162.5,FBIENS,24)
I $E(FBX,1,3)="DRG" S FBX=$E(FBX,4,999)
S FBD(0,"DRG")=FBX_U_$P(FBY(2),U,12)
;
Q
;
LINE ; FBC
; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1
; FBD(#,"AMT") = Amount Claimed^Amount Paid
; FBD(#,"CK") = Check Number^Check Date^Payment Method
; FBD(#,"835") = Routing Number^Financial Institution^^Account Number ; FB*3.5*122
; FBD(#,"DT") = Start Date^End Date
; FBD(#,"FPPS") = FPPS Line Item
; FBD(#,"RMK") = Remittance Remark1^Remittance Remark2
;
N FBADJ
;
;FPPS
S FBD(FBC,"FPPS")=$P(FBY(3),U,2)
;
;DT
S FBD(FBC,"DT")=$P(FBY(0),U,6)_U_$P(FBY(0),U,7)
;
;AMT
S FBD(FBC,"AMT")=$P(FBY(0),U,8)_U_$P(FBY(0),U,9)
;
;ADJ
D LOADADJ^FBCHFA(FBIENS,.FBADJ)
I $D(FBADJ) S FBD(FBC,"ADJ")=$$ADJL^FBUTL2(.FBADJ)
;
;RMK
S FBD(FBC,"RMK")=$$RRL^FBCHFR(FBIENS)
;
;CK
S FBD(FBC,"CK")=$P(FBY(2),U,4)_U_$P(FBY(2),U)_U_$$PAYMETH^FBFHLU($P(FBY(2),U,4))
;
;835 FB*3.5*122
I $P(FBY(2),U,13),$P(FBY(2),U,14),$P(FBY(2),U,15)'="" S FBD(FBC,"835")=$P(FBY(2),U,13)_U_$P(FBY(2),U,14)_U_$P(FBY(2),U,15)
;
;CAMT ; add disbursed and interest amounts to claim (0) level
; note - disbursed amount on file includes the interest
; since FPPS wants it w/o interest - interest is subtracted
S $P(FBD(0,"AMT"),U)=$P(FBD(0,"AMT"),U)+($P(FBY(2),U,8)-$P(FBY(2),U,9))
S $P(FBD(0,"AMT"),U,2)=$P(FBD(0,"AMT"),U,2)+$P(FBY(2),U,9)
Q
;
CKLNST() ; check line status extrinsic function
; result (0 or 1)
; 0 when line should not be sent to FPPS
; 1 when line should be sent to FPPS
N FBRET
S FBRET=1
;
; check if rejected line
I $P(FBY("FBREJ"),U)]"" S FBRET=0
;
Q FBRET
;
;FBFHLD9
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBFHLD9 4443 printed Dec 13, 2024@01:58:19 Page 2
FBFHLD9 ;OIFO/SAB-GET DATA FOR INPATIENT INVOICE ;9/9/2003
+1 ;;3.5;FEE BASIS;**61,122**;JUNE 6, 2011;Build 8
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
EN ;
+1 ; input
+2 ; FBAAIN - invoice number
+3 ; output
+4 ; If transaction type = "X" then only * items are output
+5 ; Claim Level Data
+6 ; FBD(0,"AMT") = Amount Disbursed^Amount Interest
+7 ; *FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
+8 ; FBD(0,"DAYS) = Covered Days
+9 ; FBD(0,"DRG") = DRG^DRG Weight
+10 ; FBD(0,"DT") = Invoice Date
+11 ; *FBD(0,"FPPS") = FPPS Claim ID
+12 ; *FBD(0,"INV") = Invoice #^Transaction Type^Station #
+13 ;
+14 ; Line Level Data
+15 ; FBD(1,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1
+16 ; FBD(1,"AMT") = Amount Claimed^Amount Paid
+17 ; FBD(1,"CK") = Check Number^Check Date^Payment Method
+18 ; FBD(1,"835") = Routing Number^Financial Institution^^Account Number ; FB*3.5*122
+19 ; FBD(1,"DT") = Start Date^End Date
+20 ; FBD(1,"FPPS") = FPPS Line Item
+21 ; FBD(1,"RMK") = Remittance Remark1,Remittance Remark2
+22 ;
+23 ; If exceptions for invoice
+24 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
+25 ; If warnings for invoice
+26 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
+27 ;
+28 ; initialize variables
+29 NEW DA,FBC,FBI,FBIENS,FBSTA,FBTTYP,FBY
+30 KILL FBD
+31 ;
+32 SET DA=FBAAIN
+33 SET FBIENS=DA_","
+34 FOR FBI=0,2,3,"FBREJ"
SET FBY(FBI)=$GET(^FBAAI(DA,FBI))
+35 ; skip line if status not OK to transmit
if '$$CKLNST()
QUIT
+36 SET FBC=1
+37 DO INVOICE
+38 IF FBTTYP="C"
DO LINE
+39 QUIT
+40 ;
INVOICE ; determine invoice data
+1 ; FBD(0,"AMT") = Amount Disbursed^Amount Interest
+2 ; FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
+3 ; FBD(0,"DAYS")
+4 ; FBD(0,"DRG")
+5 ; FBD(0,"DT") = Invoice Date
+6 ; FBD(0,"FPPS") = FPPS Claim ID
+7 ; FBD(0,"INV") = Invoice #^Transaction Type^Station #
+8 ; FBSTA = station number
+9 ; FBTTYP = transaction type (C or X)
+10 ;
+11 NEW FBDT,FBOB,FBX
+12 ; determine Transaction Type (based on CANCELLATION DATE)
+13 SET FBTTYP=$SELECT($PIECE(FBY(2),U,5)]"":"X",1:"C")
+14 ;
+15 ; determine station number
+16 SET FBSTA=$$STANO^FBFHLU($PIECE(FBY(0),U,17))
+17 ;
+18 ;INV
+19 SET FBD(0,"INV")=FBAAIN_U_FBTTYP_U_FBSTA
+20 ;
+21 ;FPPS
+22 SET FBD(0,"FPPS")=$PIECE(FBY(3),U)
+23 ;
+24 ;CAN
+25 ; if cancel then get cancel data
+26 IF FBTTYP="X"
Begin DoDot:1
+27 SET FBD(0,"CAN")=$PIECE(FBY(2),U,5)_U_$$GET1^DIQ(162.5,FBIENS,"50:1")_U_$PIECE(FBY(2),U,7)
End DoDot:1
QUIT
+28 ;
+29 ;AMT
+30 ; initialize sums
SET FBD(0,"AMT")="0^0"
+31 ;
+32 ;DT
+33 ; determine invoice date
+34 ; (date finalized or date paid or date supervisor closed batch)
+35 ; date finalized
SET FBDT=$PIECE(FBY(0),U,16)
+36 ; date paid
IF FBDT=""
SET FBDT=$PIECE(FBY(2),U)
+37 ; date supv closed
IF FBDT=""
IF $PIECE(FBY(0),U,17)
SET FBDT=$PIECE(^FBAA(161.7,$PIECE(FBY(0),U,17),0),U,6)
+38 SET FBD(0,"DT")=FBDT
+39 ;
+40 ;DAYS
+41 SET FBD(0,"DAYS")=+$PIECE(FBY(2),U,10)
+42 ;
+43 ;DRG
+44 SET FBX=$$GET1^DIQ(162.5,FBIENS,24)
+45 IF $EXTRACT(FBX,1,3)="DRG"
SET FBX=$EXTRACT(FBX,4,999)
+46 SET FBD(0,"DRG")=FBX_U_$PIECE(FBY(2),U,12)
+47 ;
+48 QUIT
+49 ;
LINE ; FBC
+1 ; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1
+2 ; FBD(#,"AMT") = Amount Claimed^Amount Paid
+3 ; FBD(#,"CK") = Check Number^Check Date^Payment Method
+4 ; FBD(#,"835") = Routing Number^Financial Institution^^Account Number ; FB*3.5*122
+5 ; FBD(#,"DT") = Start Date^End Date
+6 ; FBD(#,"FPPS") = FPPS Line Item
+7 ; FBD(#,"RMK") = Remittance Remark1^Remittance Remark2
+8 ;
+9 NEW FBADJ
+10 ;
+11 ;FPPS
+12 SET FBD(FBC,"FPPS")=$PIECE(FBY(3),U,2)
+13 ;
+14 ;DT
+15 SET FBD(FBC,"DT")=$PIECE(FBY(0),U,6)_U_$PIECE(FBY(0),U,7)
+16 ;
+17 ;AMT
+18 SET FBD(FBC,"AMT")=$PIECE(FBY(0),U,8)_U_$PIECE(FBY(0),U,9)
+19 ;
+20 ;ADJ
+21 DO LOADADJ^FBCHFA(FBIENS,.FBADJ)
+22 IF $DATA(FBADJ)
SET FBD(FBC,"ADJ")=$$ADJL^FBUTL2(.FBADJ)
+23 ;
+24 ;RMK
+25 SET FBD(FBC,"RMK")=$$RRL^FBCHFR(FBIENS)
+26 ;
+27 ;CK
+28 SET FBD(FBC,"CK")=$PIECE(FBY(2),U,4)_U_$PIECE(FBY(2),U)_U_$$PAYMETH^FBFHLU($PIECE(FBY(2),U,4))
+29 ;
+30 ;835 FB*3.5*122
+31 IF $PIECE(FBY(2),U,13)
IF $PIECE(FBY(2),U,14)
IF $PIECE(FBY(2),U,15)'=""
SET FBD(FBC,"835")=$PIECE(FBY(2),U,13)_U_$PIECE(FBY(2),U,14)_U_$PIECE(FBY(2),U,15)
+32 ;
+33 ;CAMT ; add disbursed and interest amounts to claim (0) level
+34 ; note - disbursed amount on file includes the interest
+35 ; since FPPS wants it w/o interest - interest is subtracted
+36 SET $PIECE(FBD(0,"AMT"),U)=$PIECE(FBD(0,"AMT"),U)+($PIECE(FBY(2),U,8)-$PIECE(FBY(2),U,9))
+37 SET $PIECE(FBD(0,"AMT"),U,2)=$PIECE(FBD(0,"AMT"),U,2)+$PIECE(FBY(2),U,9)
+38 QUIT
+39 ;
CKLNST() ; check line status extrinsic function
+1 ; result (0 or 1)
+2 ; 0 when line should not be sent to FPPS
+3 ; 1 when line should be sent to FPPS
+4 NEW FBRET
+5 SET FBRET=1
+6 ;
+7 ; check if rejected line
+8 IF $PIECE(FBY("FBREJ"),U)]""
SET FBRET=0
+9 ;
+10 QUIT FBRET
+11 ;
+12 ;FBFHLD9
