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

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

initial load of WorldVistAEHR
File size: 6.0 KB
Line 
1IBCU4 ;ALB/AAS - BILLING UTILITY ROUTINE (CONTINUED) ;12-FEB-90
2 ;;2.0;INTEGRATED BILLING;**109,122,137,245,349,371**;21-MAR-94;Build 57
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;MAP TO DGCRU4
6 ;
7DDAT ;Input transform for Statement Covers From field
8 I '$D(DA) G TO
9 S IB00=+$P(^DGCR(399,+DA,0),"^",3) I +X<$P(IB00,".",1) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X G DDAT4
10 I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4
11 D PROCDT
12 I DGPRDTB,X>DGPRDTB K X W !?4,"Can't be greater than date of specified Procedures!",*7 G DDAT4
13 G DDAT4
14DDAT1 ;Input transform for Statement covers to
15 I '$D(DA) G FROM
16 S IB00=$S($D(^DGCR(399,+DA,"U")):$P(^("U"),"^",1),1:"") I 'IB00 W !?4,"'Start Date' must be specified first!",*7 K X G DDAT4
17 I +X>DT W !?4,"Cannot bill for future treatment!",*7 K X G DDAT4
18 I +X<IB00 W !?4,"Cannot preceed the 'Start Date'!",*7 K X G DDAT4
19 ;I $S($E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4
20 ;I $$FY(+IB00)'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 G DDAT4
21 ;I $E(IB00,1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 G DDAT4
22 D PROCDT
23 I DGPRDTE,X<DGPRDTE K X W !?4,"Can't be less than date of specified Procedures!",*7 G DDAT4
24 G DDAT4
25 ;
26 ;DDAT2 ;Input transform for OP VISITS DATE(S) field REPLACED WITH IBCU41 6/15/93
27 ;S IB00=$G(^DGCR(399,IBIFN,"U")) I $P(IB00,"^",1)']"" W !?4,*7,"No 'Start Date' on file...can't enter OP visit dates..." K X G DDAT4
28 ;I $P(IB00,"^",2)']"" W !?4,*7,"No 'End Date' on file...can't enter OP visit dates..." K X G DDAT4
29 ;I X<$P(IB00,"^",1) W !?4,*7,"Can't enter a visit date prior to 'Start Date'..." K X G DDAT4
30 ;I X>$P(IB00,"^",2) W !?4,*7,"Can't enter a visit date later than 'End Date'..." K X G DDAT4
31 ;I $P(^DGCR(399,IBIFN,0),"^",19)'=2,$D(^DGCR(399,"ASC2",IBIFN)),$O(^DGCR(399,IBIFN,"OP",0)) W !?4,*7,"Only 1 visit date allowed on bills with Amb. Surg. Codes!" K X G DDAT4
32 ;D APPT^IBCU3,DUPCHK^IBCU3
33 G DDAT4
34 ;
35DDAT3 ; - x-ref call for to and from dates, REPLACED BY TRIGGERS ON .08, 151, 152 ON 10/18/93
36 ;if inpatient bill return DGNEWLOS to cause recalc of los in IBSC6
37 G DDAT4:'$D(X)
38 I $D(^DGCR(399,DA,0)),$P(^(0),"^",5)<3 S DGNEWLOS=1
39 S IB00=$S($D(^DGCR(399,+DA,"U")):^("U"),1:"") I IB00']"" K X G DDAT4
40 S IB02=$S(+$E(IB00,4,5)<10:$E(IB00,2,3),1:$E(IB00,2,3)+1),IB01=$E(IB00,1)_IB02_"0930",$P(^DGCR(399,DA,"U1"),"^",9)=IB02 ;,$P(^DGCR(399,DA,"U1"),"^",11)=$S($P(IB00,"^",2)>IB01:IB02+1,1:"")
41 ;I $P(^DGCR(399,DA,"U1"),"^",11)="" S $P(^("U1"),"^",12)=""
42 ;
43DDAT4 K IB00,IB01,IB02,IB03,DGX,DGNOAP,DGJ,DGPROC,DGPRDT,DGPRDTE,DGPRDTB Q
44 ;
45OTDAT ; Input transform for Other Care Start Date (399,48,.02)
46 I ('$G(DA(1)))!('$G(X)) Q
47 N IBX S IBX=$G(^DGCR(399,DA(1),"U"))
48 I +X<+IBX W !,?4,"Can Not Precede Bill Start Date!",!,*7 K X Q
49 I +X>+$P(IBX,U,2) W !,?4,"Can not be after Bill End Date!",!,*7 K X Q
50 Q
51 ;
52CHDAT ; Input transform for chiropractics-related dates (399/245,246,247)
53 ; Make sure that date entered is not after end date of the bill
54 Q:'$D(X)
55 N IBX,Y
56 S IBX=$P($G(^DGCR(399,+DA,"U")),U,2)
57 I IBX="" W !?4,*7,"No end date of the bill on file - can't enter chiropractics-related dates " K X Q
58 I X>+IBX S Y=IBX D DD^%DT W !,?4,*7,"This date can not be after the end date of the claim ("_Y_") " K X Q
59 Q
60 ;
61TO ;151 pseudo input x-form
62 I +X_.9<IBIDS(.03) W !?4,"Cannot precede the 'EVENT DATE'!",*7 K X Q
63 I +X>(DT_".2359") W !?4,"Cannot bill for future treatment!",*7 K X
64 Q
65FROM ;152 pseudo input x-form
66 I '$D(IBIDS(151)) W !?4,"'Start Date' must be specified first!",*7 K X Q
67 I +X<IBIDS(151) W !?4,"Cannot preceed the 'Start Date'!",*7 K X Q
68 ;I $S($E(IBIDS(151),4,5)<10:$E(IBIDS(151),2,3),1:$E(IBIDS(151),2,3)+1)'=$S($E(X,4,5)<10:$E(X,2,3),1:$E(X,2,3)+1) K X W !?4,"Must be in same fiscal year!",*7 Q
69 ;I $$FY(IBIDS(151))'=$$FY(X) K X W !?4,"Must be in same fiscal year!",*7 Q
70 ;I $E(IBIDS(151),1,3)'=$E(X,1,3) K X W !?4,"Must be in same calendar year!",*7 Q
71 Q
72 ;
73FY(DATE) ; return a dates Fiscal Year
74 N IBYR,IBFY S IBFY=""
75 I $G(DATE)?7N.E S IBYR=$S($E(DATE,4,5)<10:$E(DATE,1,3),1:$E(DATE,1,3)+1),IBFY=$E(IBYR,2,3)
76 Q IBFY
77 ;
78SPEC ; - calculate discharge specialty
79 ; - input IBids(.08) = ptf record number
80 ; - output IBids(161) = pointer to billing specialty in 399.1
81 K IBIDS(161)
82 Q:$S('$D(IBIDS(.08)):1,'$D(^DGPT(+IBIDS(.08),70)):1,'$P(^(70),"^",2):1,'$D(^DIC(42.4,+$P(^(70),"^",2),0)):1,1:0) S IBIDS(161)=$P(^DGPT(IBIDS(.08),70),"^",2)
83 S IBIDS(161)=$P($G(^DIC(42.4,+IBIDS(161),0)),"^",5) I IBIDS(161)="" K IBIDS(161) Q
84 S IBIDS(161)=$O(^DGCR(399.1,"B",IBIDS(161),0))
85 I '$D(^DGCR(399.1,+IBIDS(161),0)) K IBIDS(161)
86 Q
87 ;
88PROCDT ; - find first and last dates of procedures
89 ; can't set from and to date inside of this range
90 S (DGPRDT,DGPROC,DGPRDTE,DGPRDTB)=0
91 F S DGPROC=$O(^DGCR(399,+DA,"CP",DGPROC)) Q:'DGPROC S DGPRDT=$P($G(^DGCR(399,+DA,"CP",DGPROC,0)),"^",2) D
92 . I DGPRDTB=0!(DGPRDTB>DGPRDT) S DGPRDTB=DGPRDT
93 . I DGPRDTE=0!(DGPRDTE<DGPRDT) S DGPRDTE=DGPRDT
94 . Q
95 Q
96 ;
97TOBIN(Y,DA) ; Screen for UB-04 bill classification based on UB-04 location of care
98 ; Y = internal value of code for field .25 (UB-04 BILL CLASSIFICATION)
99 ; DA = bill ien in file 399
100 N IB0
101 S IB0=$P($G(^DGCR(399,DA,0)),U,24) ; Get UB-04 LOCATION OF CARE value
102 Q $S('IB0:0,(","_$P($G(^DGCR(399.1,+Y,0)),U,24)_",")'[(","_IB0_","):0,1:1)
103 ;
104TRIG05(X,D0) ; Trigger executed on field .05 of file 399 to set field .25
105 ; Find the correct entry in file 399.1 that corresponds to the value in .05
106 ; X = value of field .05, location of care
107 ; D0 = IEN of bill entry in file 399
108 N Z,Z0,IEN,LOC
109 S LOC=$P($G(^DGCR(399,D0,0)),U,4)
110 S IEN="",Z=0
111 I LOC'="" F S Z=$O(^DGCR(399.1,"C",X,Z)) Q:'Z S Z0=$P($G(^DGCR(399.1,Z,0)),U,23,24) I +Z0,(","_$P(Z0,U,2)_",")[(","_LOC_",") S IEN=Z Q
112 Q IEN
113 ;
114TOB(IBIFN,POS) ;Function returns the 3 digit type of bill from UB-04
115 ; fields or the position (1-3) as determined by POS (optional)
116 N Z
117 S Z=$P($G(^DGCR(399,IBIFN,0)),U,24,26),Z=$P(Z,U)_$P($G(^DGCR(399.1,+$P(Z,U,2),0)),U,2)_$P(Z,U,3)
118 Q $S('$G(POS):Z,1:$E(Z,+POS))
119 ;
Note: See TracBrowser for help on using the repository browser.