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

IBNCPDP6.m

Go to the documentation of this file.
  1. IBNCPDP6 ;OAK/ELZ - TRICARE NCPDP TOOLS; 02-AUG-96
  1. ;;2.0;INTEGRATED BILLING;**383,384,411,452,526**;21-MAR-94;Build 17
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. START(IBKEY,IBELIG,IBRT) ; initial storage done during
  1. ; billing determination check (updates allowed)
  1. ; Input: IBKEY -- 1 ; 2, where
  1. ; 1 = Pointer to the prescription in file #52
  1. ; 2 = Pointer to the refill in file #52.1, or
  1. ; 0 for the original fill
  1. ; IBELIG -- single character indicating elig indicator
  1. ; V = VETERAN
  1. ; T = TRICARE
  1. ; C = CHAMPVA
  1. ; IBRT -- Rate type pointer to be used for the bill later
  1. ;
  1. N IBCHTRN,DO,DIC,X,Y,DIE,DA,DR
  1. S IBCHTRN=$O(^IBCNR(366.15,"B",IBKEY,0))
  1. I 'IBCHTRN D
  1. . S DIC="^IBCNR(366.15,",DIC(0)="",X=IBKEY D FILE^DICN
  1. . S IBCHTRN=+Y
  1. S DIE="^IBCNR(366.15,",DA=IBCHTRN,DR=".02////^S X=IBELIG;.03////^S X=IBRT"
  1. D ^DIE
  1. Q
  1. ;
  1. BILL(IBKEY,IBCHG,IBRT) ; Create the TRICARE Rx copay charge.
  1. ; Input: IBKEY -- 1 ; 2, where
  1. ; 1 = Pointer to the prescription in file #52
  1. ; 2 = Pointer to the refill in file #52.1, or
  1. ; 0 for the original fill
  1. ; IBCHG -- charge amount
  1. ; IBRT -- rate type on 3rd party (optional)
  1. ;
  1. N IBCHTRN,IBY,IBATYP,IBSERV,IBDESC,IBUNIT,IBSL,IBFR,DA,DIE,DR,DFN,IBN,IBZ
  1. ;
  1. S IBY=1
  1. I '$G(IBKEY) G BILLQ
  1. S IBCHTRN=$O(^IBCNR(366.15,"B",IBKEY,0))
  1. I 'IBCHTRN G BILLQ
  1. S IBZ=$G(^IBCNR(366.15,IBCHTRN,0))
  1. ;
  1. ; - TRICARE?
  1. I $P(IBZ,"^",2)'="T",'$G(IBRT) G BILLQ
  1. I $G(IBRT),$P($G(^DGCR(399.3,IBRT,0)),"^")'="TRICARE" G BILLQ
  1. ;
  1. ; - already billed, need to cancel to bill
  1. I $P(IBZ,"^",4) D CANC(IBKEY)
  1. ;
  1. I $$FILE^IBRXUTL(+IBKEY,.01)="" G BILLQ
  1. ;
  1. ; - need patient
  1. S DFN=$$FILE^IBRXUTL(+IBKEY,2)
  1. I 'DFN S IBY="-1^IB002" G BILLQ
  1. ;
  1. ; - need action type
  1. S IBATYP=$O(^IBE(350.1,"E","TRICARE RX COPAY",0))
  1. I 'IBATYP S IBY="-1^IB008" G BILLQ
  1. ;
  1. ; - need facility number
  1. I '$$CHECK^IBECEAU(0) S IBY="-1^IB009" G BILLQ
  1. ;
  1. ; - need the Pharmacy service pointer; get from #350.1 and check it
  1. S IBSERV=$P($G(^IBE(350.1,1,0)),"^",4)
  1. I '$$SERV^IBARX1(IBSERV) S IBY="-1^IB003" G BILLQ
  1. ;
  1. ; - need a charge amount
  1. S IBCHG=+$G(IBCHG)
  1. I 'IBCHG S IBY="-1^IB029" G BILLQ
  1. ;
  1. ; - set remaining variables
  1. S IBDESC="TRICARE RX COPAY",IBUNIT=1
  1. S IBSL="52:"_+IBKEY S:$P(IBKEY,";",2) IBSL=IBSL_";1:"_$P(IBKEY,";",2)
  1. S IBFR=DT
  1. ;
  1. ; - add the charge to file #350
  1. D ADD^IBECEAU3 I IBY<0 G BILLQ
  1. ;
  1. ; *526 set approving official #4129
  1. I '$D(^VA(200,DUZ,0)) D DUZ^XUP(.5)
  1. ; - release the charge to AR
  1. D AR^IBR
  1. ;
  1. ; - update the rx file (#366.15)
  1. S DA=IBCHTRN,DIE="^IBCNR(366.15,",DR=".04////"_IBN D ^DIE K DA,DIE,DR
  1. ;
  1. BILLQ ;
  1. I IBY<0 D ERRMSG^IBACVA2(1,2)
  1. ;
  1. Q
  1. ;
  1. ;
  1. CANC(IBKEY) ; Cancel the TRICARE Rx copay charge.
  1. ; Input: IBKEY -- 1 ; 2, where
  1. ; 1 = Pointer to the prescription in file #52
  1. ; 2 = Pointer to the refill in file #52.1, or
  1. ; 0 for the original fill
  1. ;
  1. N IBCHTRND,IBDUZ,IBN,IBCRES,DFN,IBSITE,IBFAC,IBND,IBPARNT,IBCANC,IBH,IBCANTR,IBXA,IBATYP,IBSEQNO,IBIL,IBUNIT,IBCHG,IBFR,DIE,DA,DR,IBCHTRN,IBY
  1. ;
  1. S IBY=1,IBDUZ=DUZ
  1. S IBCHTRN=$O(^IBCNR(366.15,"B",IBKEY,0))
  1. I 'IBCHTRN G CANCQ
  1. S IBCHTRND=$G(^IBCNR(366.15,IBCHTRN,0)),DFN=$$FILE^IBRXUTL(+IBKEY,2)
  1. S IBN=+$P(IBCHTRND,"^",4) I 'IBN G CANCQ
  1. I '$$CHECK^IBECEAU(0) S IBY="-1^IB009" G CANCQ
  1. S IBCRES=$O(^IBE(350.3,"B","RX CANCELLED",0)) S:'IBCRES IBCRES=5
  1. ;
  1. ; - cancel the charge
  1. D CED^IBECEAU4(IBN) I IBY<0 G CANCQ
  1. D CANC^IBECEAU4(IBN,IBCRES,1)
  1. ;
  1. S DIE="^IBCNR(366.15,",DA=IBCHTRN,DR=".04///@" D ^DIE
  1. CANCQ ;
  1. I IBY<0 D ERRMSG^IBACVA2(0,2)
  1. ;
  1. Q
  1. ;
  1. RT(IBKEY) ; returns rate type previously determined
  1. Q $P($G(^IBCNR(366.15,+$O(^IBCNR(366.15,"B",IBKEY,0)),0)),"^",3)
  1. ;
  1. TRICARE(IBKEY) ; returns if the Key is RT TRICARE
  1. N IBRT
  1. S IBRT=+$$RT(IBKEY)
  1. Q $S($P($G(^DGCR(399.3,IBRT,0)),"^")["TRICARE":1,1:0)
  1. ;
  1. ;gets the insurance phone
  1. ;input:
  1. ; IB36 - ptr to INSURANCE COMPANY File (#36)
  1. ;output:
  1. ; the phone number
  1. PHONE(IB36) ;
  1. N IB1
  1. ;check first CLAIMS (RX) PHONE NUMBER if empty
  1. S IB1=$$GET1^DIQ(36,+IB36,.1311,"E")
  1. Q:$L(IB1)>0 IB1
  1. ;check BILLING PHONE NUMBER if empty - return nothing
  1. S IB1=$$GET1^DIQ(36,+IB36,.132,"E")
  1. Q IB1
  1. ;IBNCPDP6