1 | IBAMTV2 ;ALB/CPM - CREATE CHARGES FOR BILLABLE EPISODES ; 01-JUN-94
|
---|
2 | ;;2.0;INTEGRATED BILLING;**15,153,204**;21-MAR-94
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | BLD ; Create back charges for an array of episodes.
|
---|
6 | ;
|
---|
7 | ; Input: IBSTART -- First date that the patient is Means Test billable
|
---|
8 | ; IBEND -- Last date that the patient is Means Test billable
|
---|
9 | ; DFN -- Pointer to the patient in file #2
|
---|
10 | ;
|
---|
11 | ; ^TMP("IBAMTV",$J,episode date) = 1^2^3, where
|
---|
12 | ; 1 = adm date for inpatient care
|
---|
13 | ; visit date for outpatient care
|
---|
14 | ; 2 = disch/last bill date for inpatient care
|
---|
15 | ; null for outpatient care
|
---|
16 | ; 3 = null for inpatient care
|
---|
17 | ; softlink for outpatient care
|
---|
18 | ;
|
---|
19 | S IBJOB=9,(IBWHER,IBY,Y)=1,IBDUZ=$S($G(DUZ):DUZ,1:.5)
|
---|
20 | D SITE^IBAUTL I Y<1 S IBY=Y G BLDQ
|
---|
21 | D SERV^IBAUTL2 I IBY<1 G BLDQ
|
---|
22 | ;
|
---|
23 | ; - is there an old clock to use?
|
---|
24 | S IBCLDA=$$OLDCL(DFN,+$O(^TMP("IBAMTV",$J,0)))
|
---|
25 | I IBCLDA D CLDATA^IBAUTL3,DED^IBAUTL3
|
---|
26 | ;
|
---|
27 | ; - bill all episodes of care
|
---|
28 | S IBEPDT=0 F S IBEPDT=$O(^TMP("IBAMTV",$J,IBEPDT)) Q:'IBEPDT S IBEPSTR=$G(^(IBEPDT)) I IBEPSTR D @$S($P(IBEPSTR,"^",2):"INPT",1:"OPT") Q:IBY<0
|
---|
29 | I IBY<0 G BLDQ
|
---|
30 | ;
|
---|
31 | ; - close clock if over a year old
|
---|
32 | I IBCLDA,$$FMDIFF^XLFDT(DT,IBCLDT)>364 K IBCLDOL D CLOCKCL^IBAUTL3
|
---|
33 | ;
|
---|
34 | BLDQ I IBY<0 D ^IBAERR1
|
---|
35 | D KILL1^IBAMTC K IBEPDT,IBEPSTR
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | ;
|
---|
39 | INPT ; Bill inpatient care.
|
---|
40 | S IBEVDA=0
|
---|
41 | I IBCLDA S IBCLCT=$$FMDIFF^XLFDT(+IBEPSTR,IBCLDT)
|
---|
42 | S IBBDT=$$FMTH^XLFDT(+IBEPSTR,1)
|
---|
43 | S IBEDT=$$FMTH^XLFDT($P(IBEPSTR,"^",2),1)-1
|
---|
44 | D ^IBAUTL4 G:IBY<0 INPTQ
|
---|
45 | ;
|
---|
46 | I $G(IBCHPDA) D UPD(IBCHPDA)
|
---|
47 | I $G(IBCHCDA) D UPD(IBCHCDA)
|
---|
48 | I IBCLDA D CLUPD^IBAUTL3
|
---|
49 | I IBEVDA,$D(IBDT) S IBEVCLD=IBDT D @($S($$CLEV():"EVCLOSE",1:"EVUPD")_"^IBAUTL3")
|
---|
50 | ;
|
---|
51 | INPTQ K IBCHPDA,IBCHCDA,IBCHG,IBCHFR,IBCHTO,IBCHTOTL,IBBS,IBNH,IBTRAN,IBATYP,IBDATE
|
---|
52 | K IBEVDA,IBEVDT,IBEVCLD,IBEVCAL,IBEVNEW,IBEVOLD,IBTOTL,IBDESC,IBIL,IBSL
|
---|
53 | Q
|
---|
54 | ;
|
---|
55 | OPT ; Bill the Outpatient copayment.
|
---|
56 | ; Input: IBEPSTR -- 1^2^3, where
|
---|
57 | ; 1 => visit date
|
---|
58 | ; 2 => null
|
---|
59 | ; 3 => softlink (may be null)
|
---|
60 | ; DFN -- Pointer to the patient in file #2
|
---|
61 | ;
|
---|
62 | N %,IBSTOPDA,IBTYPE
|
---|
63 | ;
|
---|
64 | I IBCLDA,$$FMDIFF^XLFDT(+IBEPSTR,IBCLDT)>364 K IBCLDOL D CLOCKCL^IBAUTL3 G:IBY<0 OPTQ
|
---|
65 | I 'IBCLDA S IBCLDT=+IBEPSTR D CLADD^IBAUTL3 G:IBY<0 OPTQ S (IBCLDAY,IBCLDOL)=0
|
---|
66 | ;
|
---|
67 | ; - build the charge
|
---|
68 | I $P(IBEPSTR,"^",3) S IBSL="409.68:"_$P(IBEPSTR,"^",3)
|
---|
69 | S IBX="O",(IBFR,IBTO,IBDT,IBEVDT)=+IBEPSTR
|
---|
70 | ;
|
---|
71 | ; look up the copay tier info
|
---|
72 | S %=$$GETSC^IBEMTSCU(IBSL,IBEVDT) I % S IBSTOPDA=%
|
---|
73 | ; get the rate, ibtype = primary or specialty
|
---|
74 | S IBTYPE=$P($G(^IBE(352.5,+$G(IBSTOPDA),0)),"^",3) G:IBTYPE=0 OPTQ
|
---|
75 | ; if the type is not defined, must be a local created sc, set it to primary
|
---|
76 | I 'IBTYPE S IBTYPE=1
|
---|
77 | ;
|
---|
78 | ;
|
---|
79 | D TYPE^IBAUTL2 G:IBY<0 OPTQ
|
---|
80 | S IBUNIT=1,IBEVDA="*"
|
---|
81 | D ADD^IBECEAU3 G:IBY<0 OPTQ
|
---|
82 | ;
|
---|
83 | ; - place charge in the 'review' status
|
---|
84 | D UPD(IBN)
|
---|
85 | ;
|
---|
86 | OPTQ K IBUNIT,IBFR,IBTO,IBSL,IBEVDA,IBX,IBDESC,IBATYP,IBCHG,IBRTED,IBN,IBBS,IBEVDT
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | ;
|
---|
90 | OLDCL(DFN,IBDT) ; Can an old billing clock be used?
|
---|
91 | ; Input: DFN -- Pointer to the patient in file #2
|
---|
92 | ; IBDT -- Date of first potentially billable episode
|
---|
93 | ; Output: 0 -- No old billing clock available
|
---|
94 | ; >0 -- Pointer to old billing clock in file #351
|
---|
95 | I '$G(DFN) G OLDCLQ
|
---|
96 | N IBX,IBY,IBZ,IBST S IBST=0
|
---|
97 | S IBX=-(IBDT+.1) F S IBX=$O(^IBE(351,"AIVDT",DFN,IBX)) Q:'IBX D Q:IBST
|
---|
98 | .S IBY=0 F S IBY=$O(^IBE(351,"AIVDT",DFN,IBX,IBY)) Q:'IBY D Q:IBST
|
---|
99 | ..S IBZ=$G(^IBE(351,IBY,0)) Q:'IBZ!($P(IBZ,"^",4)=3)
|
---|
100 | ..I $$FMDIFF^XLFDT(IBDT,$P(IBZ,"^",3))<365 S IBST=1
|
---|
101 | OLDCLQ Q +$G(IBY)
|
---|
102 | ;
|
---|
103 | UPD(IBN) ; Place the charge in a review status.
|
---|
104 | ; Input: IBN -- Pointer to the charge in file #350
|
---|
105 | S DIE="^IB(",DA=IBN,DR=".05////21" D ^DIE K DIE,DA,DR
|
---|
106 | Q
|
---|
107 | ;
|
---|
108 | CLEV() ; Should the event record be closed?
|
---|
109 | ; Input: variables IBEVDA -- Pointer to event in file #350
|
---|
110 | ; IBEND -- Last date through which to bill
|
---|
111 | ; Output: 1 -- yes, close event
|
---|
112 | ; 0 -- don't close event
|
---|
113 | N IBX,IBZ S IBX=0
|
---|
114 | I '$G(IBEVDA)!'$G(IBEND) S IBX=1 G CLEVQ
|
---|
115 | I IBEND<$$FMADD^XLFDT(DT,-1) S IBX=1 G CLEVQ
|
---|
116 | S IBZ=+$P($P($G(^IB(IBEVDA,0)),"^",4),":",2),IBZ=$P($G(^DGPM(IBZ,0)),"^",14)
|
---|
117 | I IBZ,$P($G(^DGPM(IBZ,0)),"^",17) S IBX=1
|
---|
118 | CLEVQ Q IBX
|
---|