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

IBARXECA.m

Go to the documentation of this file. 
  1. IBARXECA ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CANCEL OLD BILLS ; 2-NOV-92
  1.  ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. % ; -- count variables
  1.  ;      Patient    Totals       Represents
  1.  ;      -------    ------       ----------
  1.  ;  5   ibcnt      ibtcnt   = : total patient count checked
  1.  ;  6   ibecnt     ibtecnt  = : total exempt patients
  1.  ;  7   ibncnt     ibtncnt  = : total non-exempt patients
  1.  ;  8   ibcecnt    ibtcecnt = : total count of exempt charges (rx's)
  1.  ;  9   ibamt      ibtamt   = : total dollar amount checked
  1.  ; 10   ibeamt     ibteamt  = : total exempt dollar amount
  1.  ; 11   ibnamt     ibtnamt  = : total non-exempt dollar amount
  1.  ; 12   ibceamt    ibtceamt = : total cancelled charges amount
  1.  ; 15   ibnecnt    ibtnecnt = : total non-exempt count
  1.  ; 16   ibbcnt     ibtbcnt  = : total bills checked
  1.  ; 17   ibcbcnt    ibtcbcnt = : total number of cancelled bills
  1.  ;
  1. CANCEL(DFN,IBDT,IBEDT) ; -- cancel all charges for a patient for a date range
  1.  ;  do not pass to ar as its done, call all at once later.
  1.  ;
  1.  D ARPARM^IBAUTL
  1.  S IBBDT=IBDT-.00001
  1.  F  S IBBDT=$O(^IB("APTDT",DFN,IBBDT)) Q:'IBBDT!((IBEDT+.9)<IBBDT)  S IBN=0 F  S IBN=$O(^IB("APTDT",DFN,IBBDT,IBN)) Q:'IBN  D BILL
  1.  ;
  1.  Q
  1.  ;
  1. BILL ; -- process cancelling one bill
  1.  S X=$G(^IB(IBN,0)) Q:X=""
  1.  Q:+$P(X,"^",4)'=52  ;quit if not pharmacy co-pay
  1.  ; find parent
  1.  S IBPARNT=$P(X,"^",9) Q:$D(^TMP($J,"IBARRY",DFN,IBPARNT))  ;don't keep checking  modifications to charge already checked
  1.  ;
  1.  S ^TMP($J,"IBARRY",DFN,IBPARNT)=""
  1.  S IBPARDT=$P($G(^IB(IBPARNT,1)),"^",2) ; get date of parent charge
  1.  I $S(IBPARDT="":1,IBPARDT<IBDT:1,IBPARDT>IBEDT:1,1:0) ; ignore charges started before or after date range
  1.  ;
  1.  ; -- get exemption status on date of charge
  1.  ;    (NOT NECESSARY, conversion will use only current exemption
  1.  ;S IBSTAT=$$RXEXMT^IBARXEU0(DFN,IBPARDT)
  1.  ;
  1.  ; -- get must recent ibaction
  1.  S IBPARNT1=IBPARNT F  S IBPARNT1=$P($G(^IB(IBPARNT,0)),"^",9) Q:IBPARNT1=IBPARNT  S IBPARNT=IBPARNT1 ;gets parent of parents, makes sure old bug where parents get lost isn't a problem
  1.  D LAST
  1.  ;
  1.  ; -- add charge amounts to corrct variable
  1.  S IBND=$G(^IB(IBLAST,0)),IBBCNT=IBBCNT+1,IBAMT=IBAMT+$P(IBND,"^",7)
  1.  S:IBSTAT IBCECNT=IBCECNT+1,IBEAMT=IBEAMT+$P(IBND,"^",7)
  1.  S:'IBSTAT IBNECNT=IBNECNT+1,IBNAMT=IBNAMT+$P(IBND,"^",7)
  1.  ;
  1.  Q:'IBSTAT  ;quit if non-exempt
  1.  Q:$P(^IBE(350.1,$P(^IB(IBLAST,0),"^",3),0),"^",5)=2  ;quit if already cancelled
  1.  ;
  1.  ; -- add cancellation charge for amount
  1.  S IBCEAMT=IBCEAMT+$P(IBND,"^",7),IBCBCNT=IBCBCNT+1 ;counts of amount of actual cancellations
  1.  S IBCRES=$O(^IBE(350.3,"B","RX COPAY INCOME EXEMPTION",0)) ; get cancellation reason
  1.  ;
  1.  D CANRX^IBARXEU3
  1.  Q
  1.  ;
  1. END ;K VARIABLES
  1.  Q
  1.  ;
  1. LAST ; -- find most recent (the last) entry for a parent action
  1.  S IBLAST=""
  1.  S IBLDT=$O(^IB("APDT",IBPARNT,"")) I +IBLDT F IBL=0:0 S IBL=$O(^IB("APDT",IBPARNT,IBLDT,IBL)) Q:'IBL  S IBLAST=IBL
  1.  I IBLAST="" S IBLAST=IBPARNT
  1.  Q