source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBARXEC3.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.6 KB
Line 
1IBARXEC3 ;ALB/AAS -RX CO-PAY INCOME EXEMPTION CONVERSION ; 2-NOV-92
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5DQ ; -- run background sweep
6 ;
7 U IO
8 S IBJOB=11
9 I $G(IBDONE)=1 G REPORT
10 S (IBTCNT,IBTECNT,IBTNCNT,IBTAMT,IBTEAMT,IBTNAMT,IBTCECNT,IBTCEAMT,IBTNECNT,IBTBCNT,IBTCBCNT,IBQUIT)=0
11 I IBARXJOB>1 S X=^IBE(350.9,1,3) D GET ; -- set variables to previous amounts
12 ;
13 ; -- Don't allow multiple conversion to run
14 D CHK G:IBQUIT DQEND
15 ;
16 ; -- Start with last patient processed
17 S DFN=+$P(^IBE(350.9,1,3),"^",4)
18 ;
19 S IBDT=$S(IBDT<$$STDATE^IBARXEU:$$STDATE^IBARXEU,1:IBDT)
20 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 "."
21 I DFN="" S IBDONE=1 D
22 .; --set done flag once completed
23 .D NOW^%DTC S $P(^IBE(350.9,1,3),"^",14)=%
24 .;
25 .D ^IBARXEC2 ;send mail message if done
26 .Q
27 ;
28REPORT ; -- start the report process here
29 D:$G(IBDONE)=1 REPORT^IBARXEC1
30DQEND D END^IBARXEC ;conversion all done
31 Q
32 ;
33PAT ; -- process one patient
34 ;
35 K ^TMP($J,"IBARRY") D KVAR^VADPT
36 S (IBCNT,IBECNT,IBCECNT,IBNCNT,IBAMT,IBEAMT,IBCEAMT,IBNAMT,IBNECNT,IBBCNT,IBCBCNT)=0
37 S IBCNT=1 ;one patient checked
38 S IBSTAT=$$RXEXMT^IBARXEU0(DFN,DT) ;get current status
39 S:IBSTAT IBECNT=1 S:'IBSTAT IBNCNT=1 ; current status count
40 ;
41 ; -- must check each charge even if patient is exempt
42 D CANCEL^IBARXECA(DFN,IBDT,IBEDT) ;cancel IB charges for patient from beg to end
43 D COUNTS
44 D CANDT^IBARXEU4 ;see if converted on the fly
45 D ARCAN^IBARXEU4(DFN,IBSTAT,$P(IBCANDT,"^"),$P(IBCANDT,"^",2))
46 ;
47PATQ Q
48 ;
49 ;
50COUNTS ; -- update the counts - Variables by:
51 ;
52 ; Patient Totals Represents
53 ; ------- ------ ----------
54 ; 5 ibcnt ibtcnt = : total patient count checked
55 ; 6 ibecnt ibtecnt = : total exempt patients
56 ; 7 ibncnt ibtncnt = : total non-exempt patients
57 ; 8 ibcecnt ibtcecnt = : total count of exempt charges (rx's)
58 ; 9 ibamt ibtamt = : total dollar amount checked
59 ; 10 ibeamt ibteamt = : total exempt dollar amount
60 ; 11 ibnamt ibtnamt = : total non-exempt dollar amount
61 ; 12 ibceamt ibtceamt = : total cancelled charges amount
62 ; 15 ibnecnt ibtnecnt = : total non-exempt count
63 ; 16 ibbcnt ibtbcnt = : total bills checked
64 ; 17 ibcbcnt ibtcbcnt = : total number of cancelled bills
65 ;
66 S IBTCNT=IBTCNT+IBCNT
67 S IBTECNT=IBTECNT+IBECNT
68 S IBTNCNT=IBTNCNT+IBNCNT
69 S IBTCECNT=IBTCECNT+IBCECNT
70 S IBTAMT=IBTAMT+IBAMT
71 S IBTEAMT=IBTEAMT+IBEAMT
72 S IBTNAMT=IBTNAMT+IBNAMT
73 S IBTCEAMT=IBTCEAMT+IBCEAMT
74 S IBTNECNT=IBTNECNT+IBNECNT
75 S IBTBCNT=IBTBCNT+IBBCNT
76 S IBTCBCNT=IBTCBCNT+IBCBCNT
77 Q:'$D(IBCONVER)
78 ;
79 ; -- set run paramters for conversion
80 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
81 Q
82 ;
83CHK ; -- Don't allow multiple conversion to run
84 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
85 Q
86 ;
87READ ; -- pause, check for an excape
88 N X,IBSHOW F R X:1 Q:'$T I X["^" D:'$D(IBSHOW) QUIC^IBARXEC1 S IBSHOW=""
89 Q
90 ;
91GET ; -- set initialization variable if restarting
92 S IBTCNT=$P(X,"^",5)
93 S IBTECNT=$P(X,"^",6)
94 S IBTNCNT=$P(X,"^",7)
95 S IBTCECNT=$P(X,"^",8)
96 S IBTAMT=$P(X,"^",9)
97 S IBTEAMT=$P(X,"^",10)
98 S IBTNAMT=$P(X,"^",11)
99 S IBTCEAMT=$P(X,"^",12)
100 S IBTNECNT=$P(X,"^",15)
101 S IBTBCNT=$P(X,"^",16)
102 S IBTCBCNT=$P(X,"^",17)
103 Q
Note: See TracBrowser for help on using the repository browser.