FBFHLD5 ;OIFO/SAB-GET DATA FOR PHARMACY INVOICE ;10/9/2003
;;3.5;FEE BASIS;**61**;JULY 18, 2003
;;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,"DT") = Invoice Date
; *FBD(0,"FPPS") = FPPS Claim ID
; *FBD(0,"INV") = Invoice #^Transaction Type^Station #
;
; Line Level Data (# is a sequential number)
; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1^AdjReason2^AdjGrp2^AdjAmt2
; FBD(#,"AMT") = Amount Claimed^Amount Paid
; FBD(#,"CK") = Check Number^Check Date^Payment Method
; FBD(#,"DT") = Date Prescription Filled
; FBD(#,"FPPS") = FPPS Line Item
; FBD(#,"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,FBRXY,FBSTA,FBTTYP,FBY
K FBD
S FBC=0 ; line count
;
S DA(1)=FBAAIN
S FBY(0)=$G(^FBAA(162.1,DA(1),0))
; loop thru prescriptions on invoice
S DA=0 F S DA=$O(^FBAA(162.1,DA(1),"RX",DA)) Q:'DA D
. S FBIENS=DA_","_DA(1)_","
. F FBI=0,2,3,"FBREJ" S FBRXY(FBI)=$G(^FBAA(162.1,DA(1),"RX",DA,FBI))
. Q:'$$CKLNST() ; skip line if status not OK to transmit
. S FBC=FBC+1
. ; if 1st line then get invoice level data
. I FBC=1 D INVOICE
. I FBTTYP="L" D LINE
Q
;
INVOICE ; determine invoice data from 1st line item
; FBD(0,"AMT") = Amount Disbursed^Amount Interest
; FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
; FBD(0,"DT") = Invoice Date
; FBD(0,"FPPS") = FPPS Claim ID
; FBD(0,"INV") = Invoice #^Transaction Type^Station #
; FBSTA = station number
; FBTTYP = transaction type (L or X)
;
N FBDT,FBOB,FBX
; determine Transaction Type (based on CANCELLATION DATE)
S FBTTYP=$S($P(FBRXY(2),U,11)]"":"X",1:"L")
;
; determine station number
S FBSTA=$$RXSTA(FBAAIN,$P(FBRXY(0),U,17))
;
;INV
S FBD(0,"INV")=FBAAIN_U_FBTTYP_U_FBSTA
;
;FPPS
S FBD(0,"FPPS")=$P(FBY(0),U,13)
;
;CAN
; if cancel then get cancel data
I FBTTYP="X" D Q
. S FBD(0,"CAN")=$P(FBRXY(2),U,11)_U_$$GET1^DIQ(162.11,FBIENS,"32:1")_U_$P(FBRXY(2),U,13)
;
;AMT
S FBD(0,"AMT")="0^0" ; initialize sums
;
;DT
; determine invoice date
; (date certified or date paid or date supervisor closed batch)
S FBDT=$P(FBRXY(0),U,19) ; date certified for payment (lines may differ)
I FBDT="" S FBDT=$P(FBRXY(2),U,8) ; date paid
I FBDT="",$P(FBRXY(0),U,17) S FBDT=$P(^FBAA(161.7,$P(FBRXY(0),U,17),0),U,6) ; date supv closed batch (for 0.00 lines)
S FBD(0,"DT")=FBDT
;
Q
;
LINE ; FBC
; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1^AdjReason2^AdjGrp2^AdjAmt2
; FBD(#,"AMT") = Amount Claimed^Amount Paid
; FBD(#,"CK") = Check Number^Check Date^Payment Method
; FBD(#,"DT") = Date of Service
; FBD(#,"FPPS") = FPPS Line Item
; FBD(#,"RMK") = Remittance Remark1^Remittance Remark2
; FBD(#,"SVC") = Service Code^Qualifier^Mod1,Mod2,Mod3,Mod4^Units
;
N FBADJ
; compare invoice transaction type (L,X) with line cancel status
I ((FBTTYP="X")&($P(FBRXY(2),U,11)=""))!((FBTTYP="L")&($P(FBRXY(2),U,11)]"")) D POST^FBFHLU(FBAAIN,"E","ALL LINES DO NOT HAVE SAME CANCEL STATUS") Q
;
;FPPS
S FBD(FBC,"FPPS")=$P(FBRXY(3),U)
;
;DT
S FBD(FBC,"DT")=$P(FBRXY(0),U,3)
;
;AMT
S FBD(FBC,"AMT")=$P(FBRXY(0),U,4)_U_$P(FBRXY(0),U,16)
;
;ADJ
D LOADADJ^FBRXFA(FBIENS,.FBADJ)
I $D(FBADJ) S FBD(FBC,"ADJ")=$$ADJL^FBUTL2(.FBADJ)
;
;RMK
S FBD(FBC,"RMK")=$$RRL^FBRXFR(FBIENS)
;
;CK
S FBD(FBC,"CK")=$P(FBRXY(2),U,10)_U_$P(FBRXY(2),U,8)_U_$$PAYMETH^FBFHLU($P(FBRXY(2),U,10))
;
;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(FBRXY(2),U,14)-$P(FBRXY(2),U,15))
S $P(FBD(0,"AMT"),U,2)=$P(FBD(0,"AMT"),U,2)+$P(FBRXY(2),U,15)
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(FBRXY("FBREJ"),U)]"" S FBRET=0
;
Q FBRET
;
RXSTA(FBAAIN,FBBATCH) ; determine station number for pharmacy
; input
; FBAAIN - invoice number in FEE BASIS PHARMACY INVOICE file
; FBBATCH - ien of entry in FEE BASIS BATCH (#161.7) file
; returns station number or NULL value
N FBRET
; if batch not input then check all line items for a batch
I 'FBBATCH D
. N DA
. S DA(1)=FBAAIN
. S DA=0 F S DA=$O(^FBAA(162.1,DA(1),"RX",DA)) Q:'DA D Q:FBBATCH
. . S FBBATCH=$P($G(^FBAA(162.1,DA(1),"RX",DA,0)),U,17)
;
; if batch known then call API to get station number
I FBBATCH S FBRET=$$STANO^FBFHLU(FBBATCH)
; if batch not known then get station number based on fee site param.
I 'FBBATCH S FBRET=$$GET1^DIQ(161.4,"1,","27:99")
;
Q FBRET
;
;FBFHLD5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBFHLD5 5286 printed Sep 23, 2025@19:34:22 Page 2
FBFHLD5 ;OIFO/SAB-GET DATA FOR PHARMACY INVOICE ;10/9/2003
+1 ;;3.5;FEE BASIS;**61**;JULY 18, 2003
+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,"DT") = Invoice Date
+9 ; *FBD(0,"FPPS") = FPPS Claim ID
+10 ; *FBD(0,"INV") = Invoice #^Transaction Type^Station #
+11 ;
+12 ; Line Level Data (# is a sequential number)
+13 ; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1^AdjReason2^AdjGrp2^AdjAmt2
+14 ; FBD(#,"AMT") = Amount Claimed^Amount Paid
+15 ; FBD(#,"CK") = Check Number^Check Date^Payment Method
+16 ; FBD(#,"DT") = Date Prescription Filled
+17 ; FBD(#,"FPPS") = FPPS Line Item
+18 ; FBD(#,"RMK") = Remittance Remark1,Remittance Remark2
+19 ;
+20 ; If exceptions for invoice
+21 ; ^TMP($J,"FBE",FBAAIN,seq number)=message
+22 ; If warnings for invoice
+23 ; ^TMP($J,"FBW",FBAAIN,seq number)=message
+24 ;
+25 ; initialize variables
+26 NEW DA,FBC,FBI,FBIENS,FBRXY,FBSTA,FBTTYP,FBY
+27 KILL FBD
+28 ; line count
SET FBC=0
+29 ;
+30 SET DA(1)=FBAAIN
+31 SET FBY(0)=$GET(^FBAA(162.1,DA(1),0))
+32 ; loop thru prescriptions on invoice
+33 SET DA=0
FOR
SET DA=$ORDER(^FBAA(162.1,DA(1),"RX",DA))
if 'DA
QUIT
Begin DoDot:1
+34 SET FBIENS=DA_","_DA(1)_","
+35 FOR FBI=0,2,3,"FBREJ"
SET FBRXY(FBI)=$GET(^FBAA(162.1,DA(1),"RX",DA,FBI))
+36 ; skip line if status not OK to transmit
if '$$CKLNST()
QUIT
+37 SET FBC=FBC+1
+38 ; if 1st line then get invoice level data
+39 IF FBC=1
DO INVOICE
+40 IF FBTTYP="L"
DO LINE
End DoDot:1
+41 QUIT
+42 ;
INVOICE ; determine invoice data from 1st line item
+1 ; FBD(0,"AMT") = Amount Disbursed^Amount Interest
+2 ; FBD(0,"CAN") = Cancel Date^Cancel Reason^Cancel Activity
+3 ; FBD(0,"DT") = Invoice Date
+4 ; FBD(0,"FPPS") = FPPS Claim ID
+5 ; FBD(0,"INV") = Invoice #^Transaction Type^Station #
+6 ; FBSTA = station number
+7 ; FBTTYP = transaction type (L or X)
+8 ;
+9 NEW FBDT,FBOB,FBX
+10 ; determine Transaction Type (based on CANCELLATION DATE)
+11 SET FBTTYP=$SELECT($PIECE(FBRXY(2),U,11)]"":"X",1:"L")
+12 ;
+13 ; determine station number
+14 SET FBSTA=$$RXSTA(FBAAIN,$PIECE(FBRXY(0),U,17))
+15 ;
+16 ;INV
+17 SET FBD(0,"INV")=FBAAIN_U_FBTTYP_U_FBSTA
+18 ;
+19 ;FPPS
+20 SET FBD(0,"FPPS")=$PIECE(FBY(0),U,13)
+21 ;
+22 ;CAN
+23 ; if cancel then get cancel data
+24 IF FBTTYP="X"
Begin DoDot:1
+25 SET FBD(0,"CAN")=$PIECE(FBRXY(2),U,11)_U_$$GET1^DIQ(162.11,FBIENS,"32:1")_U_$PIECE(FBRXY(2),U,13)
End DoDot:1
QUIT
+26 ;
+27 ;AMT
+28 ; initialize sums
SET FBD(0,"AMT")="0^0"
+29 ;
+30 ;DT
+31 ; determine invoice date
+32 ; (date certified or date paid or date supervisor closed batch)
+33 ; date certified for payment (lines may differ)
SET FBDT=$PIECE(FBRXY(0),U,19)
+34 ; date paid
IF FBDT=""
SET FBDT=$PIECE(FBRXY(2),U,8)
+35 ; date supv closed batch (for 0.00 lines)
IF FBDT=""
IF $PIECE(FBRXY(0),U,17)
SET FBDT=$PIECE(^FBAA(161.7,$PIECE(FBRXY(0),U,17),0),U,6)
+36 SET FBD(0,"DT")=FBDT
+37 ;
+38 QUIT
+39 ;
LINE ; FBC
+1 ; FBD(#,"ADJ") = AdjReason1^AdjGrp1^AdjAmt1^AdjReason2^AdjGrp2^AdjAmt2
+2 ; FBD(#,"AMT") = Amount Claimed^Amount Paid
+3 ; FBD(#,"CK") = Check Number^Check Date^Payment Method
+4 ; FBD(#,"DT") = Date of Service
+5 ; FBD(#,"FPPS") = FPPS Line Item
+6 ; FBD(#,"RMK") = Remittance Remark1^Remittance Remark2
+7 ; FBD(#,"SVC") = Service Code^Qualifier^Mod1,Mod2,Mod3,Mod4^Units
+8 ;
+9 NEW FBADJ
+10 ; compare invoice transaction type (L,X) with line cancel status
+11 IF ((FBTTYP="X")&($PIECE(FBRXY(2),U,11)=""))!((FBTTYP="L")&($PIECE(FBRXY(2),U,11)]""))
DO POST^FBFHLU(FBAAIN,"E","ALL LINES DO NOT HAVE SAME CANCEL STATUS")
QUIT
+12 ;
+13 ;FPPS
+14 SET FBD(FBC,"FPPS")=$PIECE(FBRXY(3),U)
+15 ;
+16 ;DT
+17 SET FBD(FBC,"DT")=$PIECE(FBRXY(0),U,3)
+18 ;
+19 ;AMT
+20 SET FBD(FBC,"AMT")=$PIECE(FBRXY(0),U,4)_U_$PIECE(FBRXY(0),U,16)
+21 ;
+22 ;ADJ
+23 DO LOADADJ^FBRXFA(FBIENS,.FBADJ)
+24 IF $DATA(FBADJ)
SET FBD(FBC,"ADJ")=$$ADJL^FBUTL2(.FBADJ)
+25 ;
+26 ;RMK
+27 SET FBD(FBC,"RMK")=$$RRL^FBRXFR(FBIENS)
+28 ;
+29 ;CK
+30 SET FBD(FBC,"CK")=$PIECE(FBRXY(2),U,10)_U_$PIECE(FBRXY(2),U,8)_U_$$PAYMETH^FBFHLU($PIECE(FBRXY(2),U,10))
+31 ;
+32 ;CAMT ; add disbursed and interest amounts to claim (0) level
+33 ; note - disbursed amount on file includes the interest
+34 ; since FPPS wants it w/o interest - interest is subtracted
+35 SET $PIECE(FBD(0,"AMT"),U)=$PIECE(FBD(0,"AMT"),U)+($PIECE(FBRXY(2),U,14)-$PIECE(FBRXY(2),U,15))
+36 SET $PIECE(FBD(0,"AMT"),U,2)=$PIECE(FBD(0,"AMT"),U,2)+$PIECE(FBRXY(2),U,15)
+37 QUIT
+38 ;
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(FBRXY("FBREJ"),U)]""
SET FBRET=0
+9 ;
+10 QUIT FBRET
+11 ;
RXSTA(FBAAIN,FBBATCH) ; determine station number for pharmacy
+1 ; input
+2 ; FBAAIN - invoice number in FEE BASIS PHARMACY INVOICE file
+3 ; FBBATCH - ien of entry in FEE BASIS BATCH (#161.7) file
+4 ; returns station number or NULL value
+5 NEW FBRET
+6 ; if batch not input then check all line items for a batch
+7 IF 'FBBATCH
Begin DoDot:1
+8 NEW DA
+9 SET DA(1)=FBAAIN
+10 SET DA=0
FOR
SET DA=$ORDER(^FBAA(162.1,DA(1),"RX",DA))
if 'DA
QUIT
Begin DoDot:2
+11 SET FBBATCH=$PIECE($GET(^FBAA(162.1,DA(1),"RX",DA,0)),U,17)
End DoDot:2
if FBBATCH
QUIT
End DoDot:1
+12 ;
+13 ; if batch known then call API to get station number
+14 IF FBBATCH
SET FBRET=$$STANO^FBFHLU(FBBATCH)
+15 ; if batch not known then get station number based on fee site param.
+16 IF 'FBBATCH
SET FBRET=$$GET1^DIQ(161.4,"1,","27:99")
+17 ;
+18 QUIT FBRET
+19 ;
+20 ;FBFHLD5
