Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBNCPUT3

IBNCPUT3.m

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