- 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 Jan 18, 2025@03:26:19 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