IBNCPUT3 ;ALB/SS - ePharmacy secondary billing ;12-DEC-08
;;2.0;INTEGRATED BILLING;**411,435**;21-MAR-94;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
;used by ECME
;ICR #5355
;determine if there is a bill with a given bill #
;input:
; IBBIL - bill # entered by the user
;returns:
; file #399 ien if found
; zero if not found
ISBILL(IBBIL) ;
N IB399
S IB399=+$O(^DGCR(399,"B",IBBIL,0))
I IB399>0 Q IB399 ;bill # was entered
Q 0 ;nothing was found
;
;get bill details from file #399
;Used by ECME - ICR #5355
;input:
; IB399 - bill ien of (#399)
; IBINFO - output array, by reference
;Returns two piece value:
; Piece#1 :
; -1 if an error
; the payer sequence (P-primary, S-secondary,...)
; Piece#2 :
; error message if piece#1 = -1
; otherwise - patient's DFN
;
;Output array, passed in by reference.
;Format of data returned in the array:
; IBINFO("INS IEN") - insurance ien, ien of the file (#36)
; IBINFO("INS NAME") - insurance name as a text
; IBINFO("BILL #") - bill number, field (#.01) of the file (#399)
; IBINFO("AR STATUS") - Account Receivable status for the bill
; IBINFO("DOS") - date of service (FM format)
; IBINFO("PLAN") - plan ien of (#355.3)
; IBINFO("FILL NUMBER") - refill number
; IBINFO("PRESCRIPTION") - prescription ien of file (#52) ;
BILINF(IB399,IBINFO) ;
Q:IB399=0 ""
N IBDFN,IBZZ,IBRXN,IBFIL,IB3624,IBPSEQ
;
S IBDFN=$P($G(^DGCR(399,IB399,0)),U,2)
S IBPSEQ=$P($G(^DGCR(399,IB399,0)),U,21)
I IBPSEQ="" Q "-1^Cannot determine payer sequence"
S IBINFO("INS IEN")=$P($G(^DGCR(399,IB399,"MP")),U)
S IBINFO("INS NAME")=$P($G(^DIC(36,+IBINFO("INS IEN"),0)),U)
S IBINFO("BILL #")=$P($G(^DGCR(399,IB399,0)),U,1)
S IBINFO("IB STATUS")=$P($G(^DGCR(399,IB399,0)),U,13)
S IBINFO("AR STATUS")=$P($$ARSTATA^IBJTU4(IB399),U,2)
S IBINFO("DOS")=$P($G(^DGCR(399,IB399,0)),U,3)
S IBINFO("PLAN")=$$GETPLAN(IB399)
;
S IB3624=0
S IB3624=$O(^IBA(362.4,"C",IB399,0))
I IB3624>0 D
. S IBZZ=^IBA(362.4,IB3624,0)
. I IBZZ>0 S IBINFO("PRESCRIPTION")=+$P(IBZZ,U,5),IBINFO("FILL NUMBER")=+$P(IBZZ,U,10),IBINFO("DOS")=+$P(IBZZ,U,3)
I $G(IBINFO("PRESCRIPTION"))="" Q "-1^no RX ien"
I $G(IBINFO("FILL NUMBER"))="" Q "-1^no Refill No"
;
Q IBPSEQ_U_IBDFN
;
GETPLAN(IB399) ;
N IBPLN,IBNODE
S IBPLN=0
S IBNODE=$P($G(^DGCR(399,IB399,0)),"^",21),IBNODE=$S(IBNODE="P":1,IBNODE="S":2,IBNODE="T":3,1:"")
S IBPLN=$P($G(^DGCR(399,IB399,"I"_IBNODE)),U,18)
Q IBPLN
;
;Find bill(s) for the specific RX/refill
;Used by ECME - ICR #5355
;IBRXIEN RX ien (#52)
;IBRXREF refill #
;IBRXCOB - (optional) Payer Sequence ("P"- primary,"S" - secondary,"T" -tertiary
;IBDOS-(optional)Date of Service
;IBARR - by reference to return the list of bills for the RX#
;Return:
; return 2 pieces
; piece 1 - the number of ANY (cancelled, active, etc) bills found for the RX/refill
; piece 2 - the latest active bill's ien
;Return all bills in the array IBARR as
; IBARR(IEN of the file #399 )= Bill#^status^date^insurance name^payer sequence^RX ien^Refill No
;
RXBILL(IBRXIEN,IBRXREF,IBRXCOB,IBDOS,IBARR) ;
N IB3624,IB3624V,IB399,IBRET,IBCNT,IBRXNUM,IB399ACT
S IBCNT=0
S IB3624=0
S IB399ACT=0
S IBRXNUM=$$RXAPI1^IBNCPUT1(IBRXIEN,.01,"E") ;external format
Q:IBRXNUM="" 0
F S IB3624=$O(^IBA(362.4,"B",IBRXNUM,IB3624)) Q:+IB3624=0 D
. S IB3624V=$G(^IBA(362.4,IB3624,0))
. I $P(IB3624V,U,10)'=IBRXREF Q
. I $G(IBDOS) I $P(IB3624V,U,3)'=IBDOS Q
. S IB399=+$P(IB3624V,U,2)
. I IB399=0 Q
. N IBINFARR
. S IBRET=$$BILINF(IB399,.IBINFARR)
. I +IBRET=-1 Q
. I $G(IBRXCOB)'="",$P(IBRET,U)'=IBRXCOB Q
. S IBARR(IB399)=$G(IBINFARR("BILL #"))_U_$G(IBINFARR("AR STATUS"))_U_$G(IBINFARR("DOS"))_U_$G(IBINFARR("INS NAME"))_U_($P(IBRET,U))_U_$G(IBINFARR("PRESCRIPTION"))_U_$G(IBINFARR("FILL NUMBER"))_U_$G(IBINFARR("IB STATUS"))
. I $G(IBINFARR("AR STATUS"))="A" S IB399ACT=IB399
. S IBCNT=IBCNT+1
Q IBCNT_U_IB399ACT
;
COSTTYP(IBRATYP,IBDT) ; calculate the basis of cost determination for manual claims processing
; IBRATYP - rate type (ien of file #399.3)
; IBDT - date of service
; This is to update only piece [2] of the IBRT rate type string
;
N IBRET
S IBRET=$P($$EVNTITM^IBCRU3(IBRATYP,3,"PRESCRIPTION FILL",IBDT),";",1)
Q $S(IBRET="VA COST":"C",1:"T")
;
;IBNCPUT3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBNCPUT3 4473 printed Sep 23, 2025@20:01:27 Page 2
IBNCPUT3 ;ALB/SS - ePharmacy secondary billing ;12-DEC-08
+1 ;;2.0;INTEGRATED BILLING;**411,435**;21-MAR-94;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;used by ECME
+7 ;ICR #5355
+8 ;determine if there is a bill with a given bill #
+9 ;input:
+10 ; IBBIL - bill # entered by the user
+11 ;returns:
+12 ; file #399 ien if found
+13 ; zero if not found
ISBILL(IBBIL) ;
+1 NEW IB399
+2 SET IB399=+$ORDER(^DGCR(399,"B",IBBIL,0))
+3 ;bill # was entered
IF IB399>0
QUIT IB399
+4 ;nothing was found
QUIT 0
+5 ;
+6 ;get bill details from file #399
+7 ;Used by ECME - ICR #5355
+8 ;input:
+9 ; IB399 - bill ien of (#399)
+10 ; IBINFO - output array, by reference
+11 ;Returns two piece value:
+12 ; Piece#1 :
+13 ; -1 if an error
+14 ; the payer sequence (P-primary, S-secondary,...)
+15 ; Piece#2 :
+16 ; error message if piece#1 = -1
+17 ; otherwise - patient's DFN
+18 ;
+19 ;Output array, passed in by reference.
+20 ;Format of data returned in the array:
+21 ; IBINFO("INS IEN") - insurance ien, ien of the file (#36)
+22 ; IBINFO("INS NAME") - insurance name as a text
+23 ; IBINFO("BILL #") - bill number, field (#.01) of the file (#399)
+24 ; IBINFO("AR STATUS") - Account Receivable status for the bill
+25 ; IBINFO("DOS") - date of service (FM format)
+26 ; IBINFO("PLAN") - plan ien of (#355.3)
+27 ; IBINFO("FILL NUMBER") - refill number
+28 ; IBINFO("PRESCRIPTION") - prescription ien of file (#52) ;
BILINF(IB399,IBINFO) ;
+1 if IB399=0
QUIT ""
+2 NEW IBDFN,IBZZ,IBRXN,IBFIL,IB3624,IBPSEQ
+3 ;
+4 SET IBDFN=$PIECE($GET(^DGCR(399,IB399,0)),U,2)
+5 SET IBPSEQ=$PIECE($GET(^DGCR(399,IB399,0)),U,21)
+6 IF IBPSEQ=""
QUIT "-1^Cannot determine payer sequence"
+7 SET IBINFO("INS IEN")=$PIECE($GET(^DGCR(399,IB399,"MP")),U)
+8 SET IBINFO("INS NAME")=$PIECE($GET(^DIC(36,+IBINFO("INS IEN"),0)),U)
+9 SET IBINFO("BILL #")=$PIECE($GET(^DGCR(399,IB399,0)),U,1)
+10 SET IBINFO("IB STATUS")=$PIECE($GET(^DGCR(399,IB399,0)),U,13)
+11 SET IBINFO("AR STATUS")=$PIECE($$ARSTATA^IBJTU4(IB399),U,2)
+12 SET IBINFO("DOS")=$PIECE($GET(^DGCR(399,IB399,0)),U,3)
+13 SET IBINFO("PLAN")=$$GETPLAN(IB399)
+14 ;
+15 SET IB3624=0
+16 SET IB3624=$ORDER(^IBA(362.4,"C",IB399,0))
+17 IF IB3624>0
Begin DoDot:1
+18 SET IBZZ=^IBA(362.4,IB3624,0)
+19 IF IBZZ>0
SET IBINFO("PRESCRIPTION")=+$PIECE(IBZZ,U,5)
SET IBINFO("FILL NUMBER")=+$PIECE(IBZZ,U,10)
SET IBINFO("DOS")=+$PIECE(IBZZ,U,3)
End DoDot:1
+20 IF $GET(IBINFO("PRESCRIPTION"))=""
QUIT "-1^no RX ien"
+21 IF $GET(IBINFO("FILL NUMBER"))=""
QUIT "-1^no Refill No"
+22 ;
+23 QUIT IBPSEQ_U_IBDFN
+24 ;
GETPLAN(IB399) ;
+1 NEW IBPLN,IBNODE
+2 SET IBPLN=0
+3 SET IBNODE=$PIECE($GET(^DGCR(399,IB399,0)),"^",21)
SET IBNODE=$SELECT(IBNODE="P":1,IBNODE="S":2,IBNODE="T":3,1:"")
+4 SET IBPLN=$PIECE($GET(^DGCR(399,IB399,"I"_IBNODE)),U,18)
+5 QUIT IBPLN
+6 ;
+7 ;Find bill(s) for the specific RX/refill
+8 ;Used by ECME - ICR #5355
+9 ;IBRXIEN RX ien (#52)
+10 ;IBRXREF refill #
+11 ;IBRXCOB - (optional) Payer Sequence ("P"- primary,"S" - secondary,"T" -tertiary
+12 ;IBDOS-(optional)Date of Service
+13 ;IBARR - by reference to return the list of bills for the RX#
+14 ;Return:
+15 ; return 2 pieces
+16 ; piece 1 - the number of ANY (cancelled, active, etc) bills found for the RX/refill
+17 ; piece 2 - the latest active bill's ien
+18 ;Return all bills in the array IBARR as
+19 ; IBARR(IEN of the file #399 )= Bill#^status^date^insurance name^payer sequence^RX ien^Refill No
+20 ;
RXBILL(IBRXIEN,IBRXREF,IBRXCOB,IBDOS,IBARR) ;
+1 NEW IB3624,IB3624V,IB399,IBRET,IBCNT,IBRXNUM,IB399ACT
+2 SET IBCNT=0
+3 SET IB3624=0
+4 SET IB399ACT=0
+5 ;external format
SET IBRXNUM=$$RXAPI1^IBNCPUT1(IBRXIEN,.01,"E")
+6 if IBRXNUM=""
QUIT 0
+7 FOR
SET IB3624=$ORDER(^IBA(362.4,"B",IBRXNUM,IB3624))
if +IB3624=0
QUIT
Begin DoDot:1
+8 SET IB3624V=$GET(^IBA(362.4,IB3624,0))
+9 IF $PIECE(IB3624V,U,10)'=IBRXREF
QUIT
+10 IF $GET(IBDOS)
IF $PIECE(IB3624V,U,3)'=IBDOS
QUIT
+11 SET IB399=+$PIECE(IB3624V,U,2)
+12 IF IB399=0
QUIT
+13 NEW IBINFARR
+14 SET IBRET=$$BILINF(IB399,.IBINFARR)
+15 IF +IBRET=-1
QUIT
+16 IF $GET(IBRXCOB)'=""
IF $PIECE(IBRET,U)'=IBRXCOB
QUIT
+17 SET IBARR(IB399)=$GET(IBINFARR("BILL #"))_U_$GET(IBINFARR("AR STATUS"))_U_$GET(IBINFARR("DOS"))_U_$GET(IBINFARR("INS NAME"))_U_($PIECE(IBRET,U))_U_$GET(IBINFARR("PRESCRIPTION"))_U_$GET(IBINFARR("FILL NUMBER"))_U_$GET(IBINFARR("IB STATUS
"))
+18 IF $GET(IBINFARR("AR STATUS"))="A"
SET IB399ACT=IB399
+19 SET IBCNT=IBCNT+1
End DoDot:1
+20 QUIT IBCNT_U_IB399ACT
+21 ;
COSTTYP(IBRATYP,IBDT) ; calculate the basis of cost determination for manual claims processing
+1 ; IBRATYP - rate type (ien of file #399.3)
+2 ; IBDT - date of service
+3 ; This is to update only piece [2] of the IBRT rate type string
+4 ;
+5 NEW IBRET
+6 SET IBRET=$PIECE($$EVNTITM^IBCRU3(IBRATYP,3,"PRESCRIPTION FILL",IBDT),";",1)
+7 QUIT $SELECT(IBRET="VA COST":"C",1:"T")
+8 ;
+9 ;IBNCPUT3
