- 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 Feb 18, 2025@23:24:45 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