source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBRSUTL.m@ 1638

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

initial load of WorldVistAEHR
File size: 6.1 KB
Line 
1IBRSUTL ;ALB/ARH - ASCD INTERFACE UTILITIES ; 23-MAR-07
2 ;;2.0;INTEGRATED BILLING;**369**;21-MAR-94;Build 2
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5CT(IB0E) ; Return Claims Tracking record for Outpatient Encounter
6 ; Input: IB0E - IEN of Outpatient Encounter #409.68
7 ; Output: IEN of Outpatient Encounters Claims Tracking record #356
8 ; or null if no CT entry found
9 ;
10 N IBTRN S IBTRN="" I +$G(IB0E) S IBTRN=$O(^IBT(356,"ASCE",+IB0E,0))
11 Q IBTRN
12 ;
13RNBU(IB0E,CHNG) ; Update Claims Tracking record Reason Not Billable for an Outpatient Encounter
14 ; Input: IB0E - IEN of Outpatient Encounter #409.68
15 ; CHNG - 1 if Outpatient Encounter changed from NSC to SC
16 ; 2 if Outpatient Encounter changed from SC to NSC
17 ; Output: 1 - Reason Not Billable SC TREATMENT was added to Outpatient Encounters Claims Tracking Record
18 ; also adds CT Billable Finding of NSC TO SC and Last Reviewed By
19 ; 2 - Reason Not Billable SC TREATMENT was deleted from Outpatient Encounters Claims Tracking Record
20 ; also adds CT Billable Finding of SC TO NSC and Last Reviewed By
21 ; 0 - no change made
22 ;
23 N DA,DR,DIC,DIE,DD,DO,DLAYGO,IBTRN,IBUPD,IBRNBSC,IBCTRNB,X,Y S DLAYGO=356.03,IBUPD=0
24 I +$G(IB0E) S IBTRN=+$$CT(IB0E) I +IBTRN S IBCTRNB=$P($G(^IBT(356,IBTRN,0)),U,19)
25 S IBRNBSC=$O(^IBE(356.8,"B","SC TREATMENT",""))
26 ;
27 I +$G(CHNG)=1,+IBTRN,IBCTRNB="" D S IBUPD=1 ; if CT has no RNB then add RNB of SC - NSC to SC
28 . S DA=IBTRN,DIE="^IBT(356,",DR=".19////"_IBRNBSC_";2.02////"_DUZ D ^DIE K DIE,DIC,DA,DR,X,Y
29 . S X=$O(^IBT(356.85,"B","NSC TO SC",0)) I +X S DIC(0)="L",DA(1)=IBTRN,DIC="^IBT(356,"_DA(1)_",3," D FILE^DICN
30 ;
31 I +$G(CHNG)=2,+IBTRN,IBCTRNB=IBRNBSC D S IBUPD=2 ; if CT has SC RNB then delete RNB - SC to NSC
32 . S DA=IBTRN,DIE="^IBT(356,",DR=".19////@;2.02////"_DUZ D ^DIE K DIE,DIC,DA,DR,X,Y
33 . S X=$O(^IBT(356.85,"B","SC TO NSC",0)) I +X S DIC(0)="L",DA(1)=IBTRN,DIC="^IBT(356,"_DA(1)_",3," D FILE^DICN
34 ;
35 Q IBUPD
36 ;
37FPBILL(IB0E) ; Return First Party Bill data for Outpatient Encounter, last encounter transaction if not cancelled
38 ; Input: IB0E - IEN of Outpatient Encounter #409.68
39 ; Output: First Party AR Bill Number (#350,.11) ^ AR Transaction Number (#350,.12) ^ Total Charge (#350,.07)
40 ; null if no active First Party Bill found for encounter
41 ;
42 N IB0E0,DFN,IBFROM,IBIFN,IBFP0,IBFND,IBDT,IBPAR,IBNDT,IBLAST S IBFROM="409.68:"_$G(IB0E) S IBFND=""
43 S IB0E0=$$SCE^IBSDU(+$G(IB0E)),DFN=$P(IB0E0,U,2),IBDT=+IB0E0\1
44 ;
45 I +DFN S IBIFN=0 F S IBIFN=$O(^IB("AFDT",DFN,-IBDT,IBIFN)) Q:'IBIFN D
46 . S IBFP0=$G(^IB(IBIFN,0)) I IBFROM'=$P(IBFP0,U,4) Q
47 . S IBPAR=$P(IBFP0,U,9),IBNDT=$O(^IB("APDT",IBPAR,"")),IBLAST=$O(^IB("APDT",IBPAR,IBNDT,""),-1) Q:'IBLAST
48 . S IBFP0=$G(^IB(IBLAST,0)) I $P($G(^IBE(350.1,+$P(IBFP0,U,3),0)),U,5)=2 S IBFND="" Q ; action type cancelled
49 . I +$P($G(^IBE(350.21,+$P(IBFP0,U,5),0)),U,5) S IBFND="" Q ; status cancelled
50 . S IBFND=$P(IBFP0,U,11)_U_$P(IBFP0,U,12)_U_$P(IBFP0,U,7)
51 ;
52 Q IBFND
53 ;
54TPBILL(IB0E) ; Return Third Party Bill numbers for Outpatient Encounter, only not cancelled
55 ; Input: IB0E - IEN of Outpatient Encounter #409.68
56 ; Output: Third Party Bill Number (#399,.01) ^ Third Party Bill Number (#399,.01) ^ ...
57 ; or null if no Third Party Bill found for encounter
58 ;
59 N IB0E0,DFN,IBDT,IBOPV,IBIFN,IBTP0,IBCPT,IBFND S IBFND=""
60 S IB0E0=$$SCE^IBSDU(+$G(IB0E)),DFN=$P(IB0E0,U,2),IBDT=+IB0E0\1
61 ;
62 I +DFN S IBOPV=IBDT-.1 F S IBOPV=$O(^DGCR(399,"AOPV",DFN,IBOPV)) Q:'IBOPV!(IBOPV>(IBDT+.6)) D
63 . S IBIFN=0 F S IBIFN=$O(^DGCR(399,"AOPV",DFN,IBOPV,IBIFN)) Q:'IBIFN D
64 .. S IBTP0=$G(^DGCR(399,IBIFN,0)) I $P(IBTP0,U,13)=7 Q
65 .. ;
66 .. S IBCPT=0 F S IBCPT=$O(^DGCR(399,IBIFN,"CP",IBCPT)) Q:'IBCPT I +$P($G(^DGCR(399,IBIFN,"CP",IBCPT,0)),U,20)=IB0E S IBFND=IBFND_$P(IBTP0,U,1)_U Q
67 ;
68 Q IBFND
69 ;
70FIRST(IB0E) ; Return true if Outpatient Encounter is Billable for First Party
71 ; Input: IB0E - IEN of Outpatient Encounter #409.68
72 ; Output: 0 ^ non-billable reason
73 ; 1 if encounter is First Party billable
74 ;
75 N IB0E0,DFN,IBDT,IBFND S IB0E=+$G(IB0E),IBFND=1
76 S IB0E0=$$SCE^IBSDU(+$G(IB0E)),DFN=$P(IB0E0,U,2),IBDT=+IB0E0\1 I 'DFN Q 0
77 ;
78 I '$$BIL^DGMTUB(DFN,+IBDT) S IBFND=0_U_"Patient not MT billable"
79 I '$$APPTCT^IBEFUNC(IB0E0) S IBFND=0_U_"Appt Status, not billable"
80 I $$NCTCL^IBEFUNC(IB0E0) S IBFND=0_U_"Non-count Clinic, not billable"
81 I $$IGN^IBEFUNC(+$P(IB0E0,U,10),IBDT) S IBFND=0_U_"Appt Type not MT billable"
82 I $$NBCL^IBEFUNC(+$P(IB0E0,U,4),IBDT) S IBFND=0_U_"Clinic not MT billable"
83 I $$NBCSC^IBEFUNC(+$P(IB0E0,U,3),IBDT) S IBFND=0_U_"Stop code not MT billable"
84 ;
85 Q IBFND
86 ;
87THIRD(IB0E) ; Return true if Outpatient Encounter is Billable for Third Party
88 ; Input: IB0E - IEN of Outpatient Encounter #409.68
89 ; Output: 0 ^ non-billable reason
90 ; 1 if encounter is Third Party billable
91 ;
92 N IB0E0,DFN,IBDT,IBFND S IB0E=+$G(IB0E),IBFND=1
93 S IB0E0=$$SCE^IBSDU(+$G(IB0E)),DFN=$P(IB0E0,U,2),IBDT=+IB0E0\1 I 'DFN Q 0
94 ;
95 I '$$APPTCT^IBEFUNC(IB0E0) S IBFND=0_U_"Appt Status, not billable"
96 I $$NCTCL^IBEFUNC(IB0E0) S IBFND=0_U_"Non-count Clinic, not billable"
97 I '$$RPT^IBEFUNC(+$P(IB0E0,U,10),IBDT) S IBFND=0_U_"Appt Type not TP billable"
98 I $$NBCT^IBEFUNC(+$P(IB0E0,U,4),IBDT) S IBFND=0_U_"Clinic not TP billable"
99 I $$NBST^IBEFUNC(+$P(IB0E0,U,3),IBDT) S IBFND=0_U_"Stop code not TP billable"
100 ;
101 Q IBFND
102 ;
103TPCHG(IB0E) ; Return Outpatient Encounters potential Third Party charges, based on encounters procedures
104 ; Input: IB0E - IEN of Outpatient Encounter #409.68
105 ; Output: Total Institutional Amount ^ Total Professional Amount
106 ; 0 if no encounter billable procedures with charges
107 ;
108 N IB0E0,DFN,IBDT,IBDV,IBRT,IBCPTS,IBZERR,IBFN,IBCPT,IBINST,IBPROF,IBFND S (IBINST,IBPROF)=0,IBFND=0
109 S IB0E0=$$SCE^IBSDU(+$G(IB0E)),DFN=$P(IB0E0,U,2),IBDT=+IB0E0\1,IBDV=$P(IB0E0,U,11) I 'DFN Q 0
110 S IBRT=$O(^DGCR(399.3,"B","REIMBURSABLE INS.")) I 'IBRT S IBRT=8
111 I '$$THIRD(IB0E) Q 0
112 ;
113 D GETCPT^SDOE(IB0E,"IBCPTS","IBZERR")
114 S IBFN=0 F S IBFN=$O(IBCPTS(IBFN)) Q:'IBFN D S IBFND=IBINST_U_IBPROF
115 . S IBCPT=$P(IBCPTS(IBFN),U,1)
116 . ;
117 . S IBINST=IBINST+$$BICOST^IBCRCI(IBRT,3,IBDT,"PROCEDURE",IBCPT,,IBDV,1,1)
118 . S IBPROF=IBPROF+$$BICOST^IBCRCI(IBRT,3,IBDT,"PROCEDURE",IBCPT,,IBDV,1,2)
119 ;
120 Q IBFND
Note: See TracBrowser for help on using the repository browser.