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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1IBTUBO2 ;ALB/AAS - UNBILLED AMOUNTS - GENERATE UNBILLED REPORTS ;03 Aug 2004 8:21 AM
2 ;;2.0;INTEGRATED BILLING;**19,31,32,91,123,159,192,155,309,347**;21-MAR-94;Build 24
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5INPT(DGPM) ; - Check if inpatient episode has bills or final bill; if not,
6 ; ^TMP($J,"IBTUB-INPT",NAME@@DFN,DATE,IBX)=bill status
7 ; ^TMP($J,"IBTUB-INPT_MRA",NAME@@DFN,DATE,IBX)=1 if MRA request
8 ; *Pre-set variables: DFN=patient IEN, DGPM=pointer to file #405,
9 ; IBDT=event date, IBRT=bill rate,
10 ; IBEDT=reporting period date
11 I '$G(DFN)!('$G(DGPM))!('$G(IBDT))!('$G(IBRT)) G INPTQ
12 N IBIP,IBDATA,IBNAME,IBNCF,IBXX,X,Y,IBMRA
13 S IBNAME=$P($G(^DPT(DFN,0)),U)
14 I $D(^TMP($J,"IBTUB-INPT",IBNAME_"@@"_DFN,IBDT)) G INPTQ
15 I $P($G(^DGPM(DGPM,0)),U,11) G INPTQ ; Admitted for SC condition.
16 I $$SC^IBTUBOU($P($G(^DGPM(DGPM,0)),U,16)) G INPTQ ; Check PTF for SC.
17 S (IBIP(1),IBIP(2))=0 ; Set claim flags.
18 ;
19 ; - Check patient's claims.
20 S (IBNCF,X)=0
21 F S X=$O(^DGCR(399,"C",DFN,X)) Q:'X D Q:IBIP(1)&(IBIP(2))
22 . S IBDATA=$$CKBIL^IBTUBOU(X,1) Q:IBDATA=""
23 . ;
24 . ; The admission date on the bill is different from the Event date.
25 . I $P(IBDATA,U,5)'=$P(IBDT,".") Q
26 . S IBNCF=IBNCF+1 ; Increment the number of bills on file for episode
27 . ;
28 . ; If Compile/Store & Not authorized before reporting period - Quit.
29 . I $G(IBCOMP),$S($P(IBDATA,U,2)'=2:$P(IBDATA,U,3),1:$P(IBDATA,U,6))>IBEDT Q
30 . ;
31 . S IBIP($P(IBDATA,U,4))=$S($P(IBDATA,U,2)'=2:1,1:2) ; Episode billed for inst/prof bill type
32 ;
33 I IBIP(1)=1 G:IBIP(2)=1!(IBDT<2990901) INPTQ ; Episode is billed.
34 ;
35 ; - Add to episodes missing inst./prof. bills.
36 S (IBXX,IBMRA)=""
37 ;
38 I IBIP(1)'=1 D
39 . I 'IBIP(1) S IBUNB("EPISM-I")=IBUNB("EPISM-I")+1 S:IBDET IBXX="I"
40 . I $G(IBXTRACT) S IB(1)=IB(1)+1 ; For DM extract.
41 . I IBIP(1)=2 S IBUNB("EPISM-I-MRA")=IBUNB("EPISM-I-MRA")+1 S:IBDET IBMRA="I"
42 ;
43 I IBIP(2)'=1,IBDT'<2990901 D
44 . I 'IBIP(2) S IBUNB("EPISM-P")=IBUNB("EPISM-P")+1 S:IBDET IBXX=$S(IBXX="I":"I,P",1:"P")
45 . I $G(IBXTRACT) S IB(3)=IB(3)+1 ; For DM extract.
46 . I IBIP(2)=2 S IBUNB("EPISM-P-MRA")=IBUNB("EPISM-P-MRA")+1 S:IBDET IBMRA=$S(IBMRA="I":"I,P",1:"P")
47 ;
48 I $S('IBIP(1):1,'IBIP(2):1,1:0) S IBUNB("EPISM-A")=IBUNB("EPISM-A")+1 ; Number of Admissions missing claims
49 S:IBIP(1)=2!(IBIP(2)=2) IBUNB("EPISM-A-MRA")=IBUNB("EPISM-A-MRA")+1
50 I $G(IBXTRACT) S IB(5)=IB(5)+1 ; For DM extract.
51 ;
52 I '$G(IBINMRA),IBIP(1)=2 G:IBIP(2)=1 INPTQ
53 I '$G(IBINMRA),IBIP(2)=2 G:IBIP(1)=1 INPTQ
54 ;
55 ; - Set global for report.
56 I $S($G(IBINMRA):1,1:IBXX'="") S ^TMP($J,"IBTUB-INPT",IBNAME_"@@"_DFN,IBDT,IBX)=IBNCF_U_IBXX_U_U_U_$$HOSP^IBTUBOU(DGPM)
57 I IBMRA'="",$G(IBINMRA) S ^TMP($J,"IBTUB-INPT_MRA",IBNAME_"@@"_DFN,IBDT,IBX)=1_U_IBMRA
58 ;
59INPTQ Q
60 ;
61RX(IBRX) ; - Check if prescription has been billed; if not,
62 ; ^TMP($J,"IBTUB-RX",NAME@@DFN,DATE@RX#,IBX)=bill status^drug name^
63 ; original fill date
64 ; ^TMP($J,"IBTUB-RX_MRA",NAME@@DFN,DATE@RX#,IBX)=1 if req MRA
65 ;
66 ; *Pre-set variables: DFN=patient IEN, IBDT=refill date,
67 ; IBRT=bill rate, IBRX=pointer to file #52,
68 ; IBEDT=reporting period date
69 I '$G(DFN)!('$G(IBDT))!('$G(IBRT))!('$G(IBRX)) G RXQ
70 N IBDATA,IBDAY,IBDRX,IBFL,IBFLG,IBOFD,IBNAME,IBND,IBNO,IBNCF,RX,X,RXDT,IBMRA,IBCO
71 ;
72 ; - Be sure prescription has an RX#.
73 S IBND=$$RXZERO^IBRXUTL(DFN,IBRX),IBNO=$P(IBND,U) G:IBNO="" RXQ
74 ;
75 ; - Retrieve the Prescription Original Fill Date
76 S IBOFD=$$FILE^IBRXUTL(IBRX,22)\1
77 ;
78 S IBDAY=$E(IBDT,1,7),IBDRX=IBDAY_"@@"_IBNO,IBNAME=$P($G(^DPT(DFN,0)),U)
79 ;
80 ; - Be sure that this fill was not already marked as unbilled.
81 I $D(^TMP($J,"IBTUB-RX",IBNAME_"@@"_DFN,IBDRX,IBX)) G RXQ
82 ;
83 ; - Look at all fills of the prescription that are on a claim.
84 S (IBFL,X)="",(IBFLG,IBNCF,IBNCF(0),IBMRA)=0
85 F S X=$O(^IBA(362.4,"B",IBNO,X)) Q:'X D Q:IBFL
86 . S RX=$G(^IBA(362.4,X,0)),RXDT=$P(RX,U,3)\1
87 . I RXDT=IBOFD S IBFLG=1 ; Original Fill Date Billed?
88 . I RXDT'=IBDAY Q ; RX refill and claim refill dates not the same.
89 . ;
90 . ; - Skip bill if not authorized (and not meeting other criteria).
91 . S IBDATA=$$CKBIL^IBTUBOU($P(RX,U,2)) Q:IBDATA=""
92 . S IBNCF=IBNCF+1 ; Increment the number of bills on file for the episode
93 . ; If Compile/Store & Not authorized before reporting period - Quit.
94 . I $G(IBCOMP),$S($P(IBDATA,U,2)'=2:$P(IBDATA,U,3),1:$P(IBDATA,U,6))>IBEDT S IBNONMRA=0 Q
95 . S:$P(IBDATA,U,2)'=2 IBFL=1,IBMRA=0 ; at least 1 non-MRA bill exists
96 . S:$P(IBDATA,U,2)=2 IBMRA=1 ; at least 1 MRA bill exists
97 . ;
98 ;
99 I IBFL G RXQ ; Refill has been billed.
100 ;
101RX1 ; - Calculate unbilled amounts.
102 S:'IBMRA IBUNB("PRESCRP")=IBUNB("PRESCRP")+1
103 I IBMRA S IBUNB("PRESCRP-MRA")=IBUNB("PRESCRP-MRA")+1
104 S IBCO=$$BICOST^IBCRCI(IBRT,3,IBDAY,"PRESCRIPTION FILL")
105 S:'IBMRA IBUNB("UNBILRX")=IBUNB("UNBILRX")+IBCO
106 I IBMRA S IBUNB("UNBILRX-MRA")=IBUNB("UNBILRX-MRA")+IBCO
107 I $G(IBXTRACT) D ; For DM extract.
108 . S IB(17)=IB(17)+1
109 . S IB(18)=IB(18)+IBCO
110 ;
111 ; - Set global for report.
112 D ZERO^IBRXUTL(+$P(IBND,U,6))
113 I $S($G(IBINMRA):1,1:'IBMRA) S ^TMP($J,"IBTUB-RX",IBNAME_"@@"_DFN,IBDRX,IBX)=IBNCF_U_$P($G(^VA(200,+$P(IBND,U,4),0)),U)_U_$$FILE^IBRXUTL(IBRX,22)_U_U_IBFLG_U_$G(^TMP($J,"IBDRUG",+$P(IBND,U,6),.01))
114 I IBMRA,$G(IBINMRA) S ^TMP($J,"IBTUB-RX_MRA",IBNAME_"@@"_DFN,IBDRX,IBX)=1
115 K ^TMP($J,"IBDRUG")
116 ;
117RXQ Q
Note: See TracBrowser for help on using the repository browser.