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

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1IBTUTL ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ; 21-JUN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;**23,62**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ADM(DGPMCA,VAINDT,RANDOM,IBVSIT) ; -- set up info for adding a current admission
6 ; -- Input DGPMCA = pointer for an admission to patient movement file
7 ; VAINDT = optional date for admission (default is dt)
8 ; RANDOM = whether or not this is a random sample
9 ; IBVSIT = Pointer to visit file (optional)
10 ;
11 N DA,DIC,DIE,DR,X,VAIN,VA,IBSCHED,IBSCH
12 I '$G(VAINDT) K VAINDT
13 I '$G(DGPMCA) S VA200="" D INP^VADPT S DGPMCA=VAIN(1)
14 Q:DGPMCA=""
15 S RANDOM=$S($G(RANDOM):1,1:0)
16 S X=$O(^IBT(356,"ADM",DFN,DGPMCA,0)) I X S IBTRN=X G ADMQ
17 S IBADMDT=$P(^DGPM(DGPMCA,0),"^")
18 ;S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
19 S IBETYP=+$O(^IBE(356.6,"AC",1,0))
20 S (IBSCH,IBTRN)=$O(^IBT(356,"ASCH",+$$SCH^IBTRKR2(DGPMCA),0))
21 D:'IBTRN ADDT
22 I IBTRN<1 G ADMQ
23 S DA=IBTRN,DIE="^IBT(356,"
24 L +^IBT(356,+IBTRN):10 I '$T G ADMQ
25 S DR=$$ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM)
26 D ^DIE K DA,DR,DIE
27 I $P($G(^IBT(356,IBTRN,0)),"^",32) S DA=IBTRN,DR=".32///@",DIE="^IBT(356," D ^DIE K DA,DR,DIE
28 L -^IBT(356,+IBTRN)
29 ;
30 S IBSCHED=$S($P(^DGPM(DGPMCA,0),U,25):10,1:20)
31 ;
32 ; -- if random sample add hospital review
33 I $P(^IBT(356,IBTRN,0),U,25) D PRE^IBTUTL2(DT,IBTRN,IBSCHED)
34 ;
35 ; -- if scheduled admission entry converted to admission, don't add
36 ; second insurance review
37 I $G(IBSCH) G ADMQ
38 ;
39 ; -- if insured add ins review
40 I $P(^IBT(356,IBTRN,0),U,24) D COM^IBTUTL3(DT,IBTRN,IBSCHED,$G(IBTRV))
41 ;
42ADMQ Q
43 ;
44ADDT ; -- add new entry to tracking, ibt(356
45 ;
46 N %DT,DD,DO,DIC,DR,DIE,DLAYGO,IBTR1,DINUM
47 L +^IBT(356,0):0 ;I '$T S Y="-1^IB085" G ADDTQ
48 ;I $G(^IBT(356,0))="" S Y="-1^IB086" G ADDTQ
49 S X=$P($G(^IBT(356,0)),"^",3)+1 L -^IBT(356,0)
50 S DIC="^IBT(356,",DIC(0)="L",DLAYGO=356
51 F X=X:1 L:$D(IBTR1) -^IBT(356,IBTR1) I X>0,'$D(^IBT(356,X)) S IBTR1=X L +^IBT(356,IBTR1):1 I $T,'$D(^IBT(356,X)) S DINUM=X,X=($$IBSITE())_X D FILE^DICN I +Y>0 Q
52 L -^IBT(356,IBTR1)
53 I +Y<1 S Y="-1^IB087"
54ADDTQ ;I +Y<0 D ^IBTERR
55 S IBTRN=+Y,IBNEW=1
56 Q
57 ;
58OTH(DFN,IBETYP,IBTDT) ; -- add miscellaneous entries, care may not be in data base
59 ; -- input dfn := patient pointer to 2
60 ; ibetyp := pointer to type entry in 356.6
61 ; ibtdt := episode date
62 ;
63 N X,Y,DA,DR,DIE,DIC
64 S X=$O(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0)) I X S IBTRN=X G OTHQ
65 D ADDT
66 I IBTRN<1 G OTHQ
67 S DA=IBTRN,DIE="^IBT(356,"
68 S DR=".02////"_$G(DFN)_";.06////"_+$G(IBTDT)_";.18////"_IBETYP_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,IBTDT)
69 L +^IBT(356,+IBTRN):10 I '$T G OTHQ
70 D ^DIE K DA,DR,DIE
71 L -^IBT(356,+IBTRN)
72OTHQ Q
73 ;
74IBSITE() ; -- calculate site from site parameters
75 ; -- output ibsite = station number
76 ;
77 N IBFAC,IBSITE
78 D SITE^IBAUTL
79 Q IBSITE
80 ;
81ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM) ; -- set up dr string for admissions
82 S DR=""
83 I '$G(IBETYP)!'$G(IBADMDT) G ADMDRQ
84 S DR=".02////"_$G(DFN)_";.03////"_$G(IBVSIT)_";.05////"_$G(DGPMCA)_";.06////"_+$G(IBADMDT)_";.18////"_$G(IBETYP)_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,$G(IBADMDT)) D
85 .I $G(DGPMCA),$G(RANDOM) S DR=DR_";.25////1" Q
86ADMDRQ Q DR
87 ;
88EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
89 ; -- input IBETYPE = pointer to type of entry file
90 ; IBTDT = episode date, if not passed in uses DT
91 ;
92 N X,X1,X2,Y,IBETYPD S Y="" I '$G(IBETYP) G EABDQ
93 S IBETYPD=$G(^IBE(356.6,+IBETYP,0)) I '$G(IBTDT) S IBTDT=DT
94 I '$P(IBETYPD,"^",4) G EABDQ ; automated billing turned off
95 S X2=+$P(IBETYPD,"^",6) ;set earliest autobill date to entered date plus days delay
96 S X1=IBTDT D C^%DTC S Y=X\1
97EABDQ Q Y
98 ;
99BILL(IBTRN) ;check if event is billable, return EABD if it is
100 N X,Y,Z,IBTRND S (X,Y)="" S IBTRND=$G(^IBT(356,+$G(IBTRN),0)) I IBTRND="" G BILLQ
101 ;
102 ; -- billed and bill not cancelled and not inpt interim first or continuous
103 I +$P(IBTRND,U,11) S Z=$$BILLED^IBCU8(IBTRN),Y=$P(Z,U,2) I +Z,'Y G BILLQ
104 ;
105 ; -- special type (not riem. ins), not billable, inactive
106 I +$P(IBTRND,U,12)!(+$P(IBTRND,U,19))!('$P(IBTRND,U,20)) G BILLQ
107 I 'Y S Y=+$G(^IBT(356,+$G(IBTRN),1)) I 'Y S Y=DT
108 S X=$$EABD(+$P(IBTRND,U,18),Y)
109BILLQ Q X
110 ;
111STOBIL Q
112KTOBIL Q
Note: See TracBrowser for help on using the repository browser.