IBARXECA.m

IBARXECA	;ALB/AAS -RX CO-PAY INCOME EXEMPTION CANCEL OLD BILLS ; 2-NOV-92

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

%	; -- count variables

	;      Patient    Totals       Represents

	;      -------    ------       ----------

	;  5   ibcnt      ibtcnt   = : total patient count checked

	;  6   ibecnt     ibtecnt  = : total exempt patients

	;  7   ibncnt     ibtncnt  = : total non-exempt patients

	;  8   ibcecnt    ibtcecnt = : total count of exempt charges (rx's)

	;  9   ibamt      ibtamt   = : total dollar amount checked

	; 10   ibeamt     ibteamt  = : total exempt dollar amount

	; 11   ibnamt     ibtnamt  = : total non-exempt dollar amount

	; 12   ibceamt    ibtceamt = : total cancelled charges amount

	; 15   ibnecnt    ibtnecnt = : total non-exempt count

	; 16   ibbcnt     ibtbcnt  = : total bills checked

	; 17   ibcbcnt    ibtcbcnt = : total number of cancelled bills

	;

CANCEL(DFN,IBDT,IBEDT)	; -- cancel all charges for a patient for a date range

	;  do not pass to ar as its done, call all at once later.

	;

	D ARPARM^IBAUTL

	S IBBDT=IBDT-.00001

	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

	;

	Q

	;

BILL	; -- process cancelling one bill

	S X=$G(^IB(IBN,0)) Q:X=""

	Q:+$P(X,"^",4)'=52  ;quit if not pharmacy co-pay

	; find parent

	S IBPARNT=$P(X,"^",9) Q:$D(^TMP($J,"IBARRY",DFN,IBPARNT))  ;don't keep checking  modifications to charge already checked

	;

	S ^TMP($J,"IBARRY",DFN,IBPARNT)=""

	S IBPARDT=$P($G(^IB(IBPARNT,1)),"^",2) ; get date of parent charge

	I $S(IBPARDT="":1,IBPARDT<IBDT:1,IBPARDT>IBEDT:1,1:0) ; ignore charges started before or after date range

	;

	; -- get exemption status on date of charge

	;    (NOT NECESSARY, conversion will use only current exemption

	;S IBSTAT=$$RXEXMT^IBARXEU0(DFN,IBPARDT)

	;

	; -- get must recent ibaction

	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

	D LAST

	;

	; -- add charge amounts to corrct variable

	S IBND=$G(^IB(IBLAST,0)),IBBCNT=IBBCNT+1,IBAMT=IBAMT+$P(IBND,"^",7)

	S:IBSTAT IBCECNT=IBCECNT+1,IBEAMT=IBEAMT+$P(IBND,"^",7)

	S:'IBSTAT IBNECNT=IBNECNT+1,IBNAMT=IBNAMT+$P(IBND,"^",7)

	;

	Q:'IBSTAT  ;quit if non-exempt

	Q:$P(^IBE(350.1,$P(^IB(IBLAST,0),"^",3),0),"^",5)=2  ;quit if already cancelled

	;

	; -- add cancellation charge for amount

	S IBCEAMT=IBCEAMT+$P(IBND,"^",7),IBCBCNT=IBCBCNT+1 ;counts of amount of actual cancellations

	S IBCRES=$O(^IBE(350.3,"B","RX COPAY INCOME EXEMPTION",0)) ; get cancellation reason

	;

	D CANRX^IBARXEU3

	Q

	;

END	;K VARIABLES

	Q

	;

LAST	; -- find most recent (the last) entry for a parent action

	S IBLAST=""

	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

	I IBLAST="" S IBLAST=IBPARNT

	Q

IBARXECA  ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CANCEL OLD BILLS ; 2-NOV-92

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

%         ; -- count variables

 +1       ;      Patient    Totals       Represents

 +2       ;      -------    ------       ----------

 +3       ;  5   ibcnt      ibtcnt   = : total patient count checked

 +4       ;  6   ibecnt     ibtecnt  = : total exempt patients

 +5       ;  7   ibncnt     ibtncnt  = : total non-exempt patients

 +6       ;  8   ibcecnt    ibtcecnt = : total count of exempt charges (rx's)

 +7       ;  9   ibamt      ibtamt   = : total dollar amount checked

 +8       ; 10   ibeamt     ibteamt  = : total exempt dollar amount

 +9       ; 11   ibnamt     ibtnamt  = : total non-exempt dollar amount

 +10      ; 12   ibceamt    ibtceamt = : total cancelled charges amount

 +11      ; 15   ibnecnt    ibtnecnt = : total non-exempt count

 +12      ; 16   ibbcnt     ibtbcnt  = : total bills checked

 +13      ; 17   ibcbcnt    ibtcbcnt = : total number of cancelled bills

 +14      ;

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.

 +2       ;

 +3        DO ARPARM^IBAUTL

 +4        SET IBBDT=IBDT-.00001

 +5        FOR 

               SET IBBDT=$ORDER(^IB("APTDT",DFN,IBBDT))

               IF 'IBBDT!((IBEDT+.9)<IBBDT)

                   QUIT 

               SET IBN=0

               FOR 

                   SET IBN=$ORDER(^IB("APTDT",DFN,IBBDT,IBN))

                   IF 'IBN

                       QUIT 

                   DO BILL

 +6       ;

 +7        QUIT 

 +8       ;

BILL      ; -- process cancelling one bill

 +1        SET X=$GET(^IB(IBN,0))

           IF X=""

               QUIT 

 +2       ;quit if not pharmacy co-pay

           IF +$PIECE(X,"^",4)'=52

               QUIT 

 +3       ; find parent

 +4       ;don't keep checking  modifications to charge already checked

           SET IBPARNT=$PIECE(X,"^",9)

           IF $DATA(^TMP($JOB,"IBARRY",DFN,IBPARNT))

               QUIT 

 +5       ;

 +6        SET ^TMP($JOB,"IBARRY",DFN,IBPARNT)=""

 +7       ; get date of parent charge

           SET IBPARDT=$PIECE($GET(^IB(IBPARNT,1)),"^",2)

 +8       ; ignore charges started before or after date range

           IF $SELECT(IBPARDT="":1,IBPARDT<IBDT:1,IBPARDT>IBEDT:1,1:0)

 +9       ;

 +10      ; -- get exemption status on date of charge

 +11      ;    (NOT NECESSARY, conversion will use only current exemption

 +12      ;S IBSTAT=$$RXEXMT^IBARXEU0(DFN,IBPARDT)

 +13      ;

 +14      ; -- get must recent ibaction

 +15      ;gets parent of parents, makes sure old bug where parents get lost isn't a problem

           SET IBPARNT1=IBPARNT

           FOR 

               SET IBPARNT1=$PIECE($GET(^IB(IBPARNT,0)),"^",9)

               IF IBPARNT1=IBPARNT

                   QUIT 

               SET IBPARNT=IBPARNT1

 +16       DO LAST

 +17      ;

 +18      ; -- add charge amounts to corrct variable

 +19       SET IBND=$GET(^IB(IBLAST,0))

           SET IBBCNT=IBBCNT+1

           SET IBAMT=IBAMT+$PIECE(IBND,"^",7)

 +20       IF IBSTAT

               SET IBCECNT=IBCECNT+1

               SET IBEAMT=IBEAMT+$PIECE(IBND,"^",7)

 +21       IF 'IBSTAT

               SET IBNECNT=IBNECNT+1

               SET IBNAMT=IBNAMT+$PIECE(IBND,"^",7)

 +22      ;

 +23      ;quit if non-exempt

           IF 'IBSTAT

               QUIT 

 +24      ;quit if already cancelled

           IF $PIECE(^IBE(350.1,$PIECE(^IB(IBLAST,0),"^",3),0),"^",5)=2

               QUIT 

 +25      ;

 +26      ; -- add cancellation charge for amount

 +27      ;counts of amount of actual cancellations

           SET IBCEAMT=IBCEAMT+$PIECE(IBND,"^",7)

           SET IBCBCNT=IBCBCNT+1

 +28      ; get cancellation reason

           SET IBCRES=$ORDER(^IBE(350.3,"B","RX COPAY INCOME EXEMPTION",0))

 +29      ;

 +30       DO CANRX^IBARXEU3

 +31       QUIT 

 +32      ;

END       ;K VARIABLES

 +1        QUIT 

 +2       ;

LAST      ; -- find most recent (the last) entry for a parent action

 +1        SET IBLAST=""

 +2        SET IBLDT=$ORDER(^IB("APDT",IBPARNT,""))

           IF +IBLDT

               FOR IBL=0:0

                   SET IBL=$ORDER(^IB("APDT",IBPARNT,IBLDT,IBL))

                   IF 'IBL

                       QUIT 

                   SET IBLAST=IBL

 +3        IF IBLAST=""

               SET IBLAST=IBPARNT

 +4        QUIT