IBARXEC3 ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CONVERSION ; 2-NOV-92
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
DQ ; -- run background sweep
;
U IO
S IBJOB=11
I $G(IBDONE)=1 G REPORT
S (IBTCNT,IBTECNT,IBTNCNT,IBTAMT,IBTEAMT,IBTNAMT,IBTCECNT,IBTCEAMT,IBTNECNT,IBTBCNT,IBTCBCNT,IBQUIT)=0
I IBARXJOB>1 S X=^IBE(350.9,1,3) D GET ; -- set variables to previous amounts
;
; -- Don't allow multiple conversion to run
D CHK G:IBQUIT DQEND
;
; -- Start with last patient processed
S DFN=+$P(^IBE(350.9,1,3),"^",4)
;
S IBDT=$S(IBDT<$$STDATE^IBARXEU:$$STDATE^IBARXEU,1:IBDT)
F S DFN=$O(^IB("APTDT",DFN)) Q:'DFN D CHK Q:IBQUIT I $O(^IB("APTDT",DFN,(IBDT-.01)))'>IBEDT D PAT I '$D(ZTQUEUED),'(IBTCNT#10) D READ W "."
I DFN="" S IBDONE=1 D
.; --set done flag once completed
.D NOW^%DTC S $P(^IBE(350.9,1,3),"^",14)=%
.;
.D ^IBARXEC2 ;send mail message if done
.Q
;
REPORT ; -- start the report process here
D:$G(IBDONE)=1 REPORT^IBARXEC1
DQEND D END^IBARXEC ;conversion all done
Q
;
PAT ; -- process one patient
;
K ^TMP($J,"IBARRY") D KVAR^VADPT
S (IBCNT,IBECNT,IBCECNT,IBNCNT,IBAMT,IBEAMT,IBCEAMT,IBNAMT,IBNECNT,IBBCNT,IBCBCNT)=0
S IBCNT=1 ;one patient checked
S IBSTAT=$$RXEXMT^IBARXEU0(DFN,DT) ;get current status
S:IBSTAT IBECNT=1 S:'IBSTAT IBNCNT=1 ; current status count
;
; -- must check each charge even if patient is exempt
D CANCEL^IBARXECA(DFN,IBDT,IBEDT) ;cancel IB charges for patient from beg to end
D COUNTS
D CANDT^IBARXEU4 ;see if converted on the fly
D ARCAN^IBARXEU4(DFN,IBSTAT,$P(IBCANDT,"^"),$P(IBCANDT,"^",2))
;
PATQ Q
;
;
COUNTS ; -- update the counts - Variables by:
;
; 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
;
S IBTCNT=IBTCNT+IBCNT
S IBTECNT=IBTECNT+IBECNT
S IBTNCNT=IBTNCNT+IBNCNT
S IBTCECNT=IBTCECNT+IBCECNT
S IBTAMT=IBTAMT+IBAMT
S IBTEAMT=IBTEAMT+IBEAMT
S IBTNAMT=IBTNAMT+IBNAMT
S IBTCEAMT=IBTCEAMT+IBCEAMT
S IBTNECNT=IBTNECNT+IBNECNT
S IBTBCNT=IBTBCNT+IBBCNT
S IBTCBCNT=IBTCBCNT+IBCBCNT
Q:'$D(IBCONVER)
;
; -- set run paramters for conversion
S $P(^IBE(350.9,1,3),"^",4,12)=DFN_U_IBTCNT_U_IBTECNT_U_IBTNCNT_U_IBTCECNT_U_IBTAMT_U_IBTEAMT_U_IBTNAMT_U_IBTCEAMT,$P(^(3),"^",15,17)=IBTNECNT_U_IBTBCNT_U_IBTCBCNT
Q
;
CHK ; -- Don't allow multiple conversion to run
I IBARXJOB'=$P(^IBE(350.9,1,3),"^",3) W !!,"The Integrated Billing Check of Pharmacy Copay Exemption due to Income",!,"was terminated. Appears to be already running!" S IBQUIT=1
Q
;
READ ; -- pause, check for an excape
N X,IBSHOW F R X:1 Q:'$T I X["^" D:'$D(IBSHOW) QUIC^IBARXEC1 S IBSHOW=""
Q
;
GET ; -- set initialization variable if restarting
S IBTCNT=$P(X,"^",5)
S IBTECNT=$P(X,"^",6)
S IBTNCNT=$P(X,"^",7)
S IBTCECNT=$P(X,"^",8)
S IBTAMT=$P(X,"^",9)
S IBTEAMT=$P(X,"^",10)
S IBTNAMT=$P(X,"^",11)
S IBTCEAMT=$P(X,"^",12)
S IBTNECNT=$P(X,"^",15)
S IBTBCNT=$P(X,"^",16)
S IBTCBCNT=$P(X,"^",17)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBARXEC3 3744 printed Sep 23, 2025@19:43:23 Page 2
IBARXEC3 ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CONVERSION ; 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 ;
DQ ; -- run background sweep
+1 ;
+2 USE IO
+3 SET IBJOB=11
+4 IF $GET(IBDONE)=1
GOTO REPORT
+5 SET (IBTCNT,IBTECNT,IBTNCNT,IBTAMT,IBTEAMT,IBTNAMT,IBTCECNT,IBTCEAMT,IBTNECNT,IBTBCNT,IBTCBCNT,IBQUIT)=0
+6 ; -- set variables to previous amounts
IF IBARXJOB>1
SET X=^IBE(350.9,1,3)
DO GET
+7 ;
+8 ; -- Don't allow multiple conversion to run
+9 DO CHK
if IBQUIT
GOTO DQEND
+10 ;
+11 ; -- Start with last patient processed
+12 SET DFN=+$PIECE(^IBE(350.9,1,3),"^",4)
+13 ;
+14 SET IBDT=$SELECT(IBDT<$$STDATE^IBARXEU:$$STDATE^IBARXEU,1:IBDT)
+15 FOR
SET DFN=$ORDER(^IB("APTDT",DFN))
if 'DFN
QUIT
DO CHK
if IBQUIT
QUIT
IF $ORDER(^IB("APTDT",DFN,(IBDT-.01)))'>IBEDT
DO PAT
IF '$DATA(ZTQUEUED)
IF '(IBTCNT#10)
DO READ
WRITE "."
+16 IF DFN=""
SET IBDONE=1
Begin DoDot:1
+17 ; --set done flag once completed
+18 DO NOW^%DTC
SET $PIECE(^IBE(350.9,1,3),"^",14)=%
+19 ;
+20 ;send mail message if done
DO ^IBARXEC2
+21 QUIT
End DoDot:1
+22 ;
REPORT ; -- start the report process here
+1 if $GET(IBDONE)=1
DO REPORT^IBARXEC1
DQEND ;conversion all done
DO END^IBARXEC
+1 QUIT
+2 ;
PAT ; -- process one patient
+1 ;
+2 KILL ^TMP($JOB,"IBARRY")
DO KVAR^VADPT
+3 SET (IBCNT,IBECNT,IBCECNT,IBNCNT,IBAMT,IBEAMT,IBCEAMT,IBNAMT,IBNECNT,IBBCNT,IBCBCNT)=0
+4 ;one patient checked
SET IBCNT=1
+5 ;get current status
SET IBSTAT=$$RXEXMT^IBARXEU0(DFN,DT)
+6 ; current status count
if IBSTAT
SET IBECNT=1
if 'IBSTAT
SET IBNCNT=1
+7 ;
+8 ; -- must check each charge even if patient is exempt
+9 ;cancel IB charges for patient from beg to end
DO CANCEL^IBARXECA(DFN,IBDT,IBEDT)
+10 DO COUNTS
+11 ;see if converted on the fly
DO CANDT^IBARXEU4
+12 DO ARCAN^IBARXEU4(DFN,IBSTAT,$PIECE(IBCANDT,"^"),$PIECE(IBCANDT,"^",2))
+13 ;
PATQ QUIT
+1 ;
+2 ;
COUNTS ; -- update the counts - Variables by:
+1 ;
+2 ; Patient Totals Represents
+3 ; ------- ------ ----------
+4 ; 5 ibcnt ibtcnt = : total patient count checked
+5 ; 6 ibecnt ibtecnt = : total exempt patients
+6 ; 7 ibncnt ibtncnt = : total non-exempt patients
+7 ; 8 ibcecnt ibtcecnt = : total count of exempt charges (rx's)
+8 ; 9 ibamt ibtamt = : total dollar amount checked
+9 ; 10 ibeamt ibteamt = : total exempt dollar amount
+10 ; 11 ibnamt ibtnamt = : total non-exempt dollar amount
+11 ; 12 ibceamt ibtceamt = : total cancelled charges amount
+12 ; 15 ibnecnt ibtnecnt = : total non-exempt count
+13 ; 16 ibbcnt ibtbcnt = : total bills checked
+14 ; 17 ibcbcnt ibtcbcnt = : total number of cancelled bills
+15 ;
+16 SET IBTCNT=IBTCNT+IBCNT
+17 SET IBTECNT=IBTECNT+IBECNT
+18 SET IBTNCNT=IBTNCNT+IBNCNT
+19 SET IBTCECNT=IBTCECNT+IBCECNT
+20 SET IBTAMT=IBTAMT+IBAMT
+21 SET IBTEAMT=IBTEAMT+IBEAMT
+22 SET IBTNAMT=IBTNAMT+IBNAMT
+23 SET IBTCEAMT=IBTCEAMT+IBCEAMT
+24 SET IBTNECNT=IBTNECNT+IBNECNT
+25 SET IBTBCNT=IBTBCNT+IBBCNT
+26 SET IBTCBCNT=IBTCBCNT+IBCBCNT
+27 if '$DATA(IBCONVER)
QUIT
+28 ;
+29 ; -- set run paramters for conversion
+30 SET $PIECE(^IBE(350.9,1,3),"^",4,12)=DFN_U_IBTCNT_U_IBTECNT_U_IBTNCNT_U_IBTCECNT_U_IBTAMT_U_IBTEAMT_U_IBTNAMT_U_IBTCEAMT
SET $PIECE(^(3),"^",15,17)=IBTNECNT_U_IBTBCNT_U_IBTCBCNT
+31 QUIT
+32 ;
CHK ; -- Don't allow multiple conversion to run
+1 IF IBARXJOB'=$PIECE(^IBE(350.9,1,3),"^",3)
WRITE !!,"The Integrated Billing Check of Pharmacy Copay Exemption due to Income",!,"was terminated. Appears to be already running!"
SET IBQUIT=1
+2 QUIT
+3 ;
READ ; -- pause, check for an excape
+1 NEW X,IBSHOW
FOR
READ X:1
if '$TEST
QUIT
IF X["^"
if '$DATA(IBSHOW)
DO QUIC^IBARXEC1
SET IBSHOW=""
+2 QUIT
+3 ;
GET ; -- set initialization variable if restarting
+1 SET IBTCNT=$PIECE(X,"^",5)
+2 SET IBTECNT=$PIECE(X,"^",6)
+3 SET IBTNCNT=$PIECE(X,"^",7)
+4 SET IBTCECNT=$PIECE(X,"^",8)
+5 SET IBTAMT=$PIECE(X,"^",9)
+6 SET IBTEAMT=$PIECE(X,"^",10)
+7 SET IBTNAMT=$PIECE(X,"^",11)
+8 SET IBTCEAMT=$PIECE(X,"^",12)
+9 SET IBTNECNT=$PIECE(X,"^",15)
+10 SET IBTBCNT=$PIECE(X,"^",16)
+11 SET IBTCBCNT=$PIECE(X,"^",17)
+12 QUIT
