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

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1IBAMTV2 ;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 ;
5BLD ; 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 ;
34BLDQ I IBY<0 D ^IBAERR1
35 D KILL1^IBAMTC K IBEPDT,IBEPSTR
36 Q
37 ;
38 ;
39INPT ; 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 ;
51INPTQ 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 ;
55OPT ; 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 ;
86OPTQ K IBUNIT,IBFR,IBTO,IBSL,IBEVDA,IBX,IBDESC,IBATYP,IBCHG,IBRTED,IBN,IBBS,IBEVDT
87 Q
88 ;
89 ;
90OLDCL(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
101OLDCLQ Q +$G(IBY)
102 ;
103UPD(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 ;
108CLEV() ; 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
118CLEVQ Q IBX
Note: See TracBrowser for help on using the repository browser.